; The Axe equivalence checker
;
; Copyright (C) 2008-2011 Eric Smith and Stanford University
; Copyright (C) 2013-2026 Kestrel Institute
; Copyright (C) 2016-2020 Kestrel Technology, LLC
;
; License: A 3-clause BSD license. See the file books/3BSD-mod.txt.
;
; Author: Eric Smith (eric.smith@kestrel.edu)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "ACL2")

(include-book "find-probable-facts")
(include-book "rules-in-rule-lists")
(include-book "make-axe-rules2")
(include-book "equivalence-checker-helpers") ; not strictly necessary; helpful functions and justifications of correctness
(include-book "sweep-and-merge-support")
(include-book "kestrel/alists-light/assoc-equal" :dir :system)
(include-book "kestrel/alists-light/clear-keys" :dir :system)
;(include-book "kestrel/alists-light/lookup-equal-lst" :dir :system)
(include-book "kestrel/utilities/get-vars-from-term" :dir :system)
(include-book "kestrel/utilities/strip-stars-from-name" :dir :system)
(include-book "kestrel/utilities/defmacrodoc" :dir :system)
(include-book "rewriter") ;TODO: brings in JVM stuff and skip-proofs ; use rewriter-basic instead? but may need support for nested DAGs
;(include-book "rewriter-alt") ;TODO: brings in JVM stuff...
(include-book "identical-xor-nests")
(include-book "kestrel/utilities/check-boolean" :dir :system)
(include-book "kestrel/utilities/print-levels" :dir :system)
(include-book "kestrel/utilities/redundancy" :dir :system)
(include-book "kestrel/utilities/keyword-value-lists2" :dir :system)
(include-book "kestrel/utilities/subtermp" :dir :system)
(include-book "kestrel/utilities/unify" :dir :system)
(include-book "kestrel/alists-light/remove-assoc-equal" :dir :system)
(include-book "kestrel/utilities/progn" :dir :system)
(include-book "kestrel/utilities/fresh-names2" :dir :system)
(include-book "kestrel/utilities/make-event-quiet" :dir :system)
(include-book "kestrel/alists-light/lookup-safe" :dir :system)
(include-book "kestrel/alists-light/lookup-equal-safe" :dir :system)
(local (include-book "kestrel/typed-lists-light/integer-listp" :dir :system))
(include-book "kestrel/typed-lists-light/integer-list-listp" :dir :system)
(include-book "kestrel/typed-lists-light/minelem" :dir :system)
(include-book "kestrel/typed-lists-light/map-strip-cars" :dir :system)
(include-book "kestrel/lists-light/union-eql-tail" :dir :system)
(include-book "strengthen-facts")
(include-book "prove-with-stp2")
(include-book "tailtohead")
(include-book "specialize")
(include-book "unroller")
(include-book "contexts2")
(include-book "concretize-with-contexts")
(include-book "letify-term-via-dag")
(include-book "subdagp") ; for subdag-of-somep
(include-book "arrays-of-alists")
;(include-book "generic-head-aux-proof")
(include-book "print-dag-to-file")
(include-book "print-dag-array-to-file")
(include-book "kestrel/utilities/system/fresh-names" :dir :system)
;; Bring in the necessary rules (TODO: Drop these include-books after removing
;; mentions of axe-rules, amazing-rules-spec-and-dag, etc. in this file):
(include-book "kestrel/bv-lists/packbv-theorems" :dir :system)
(include-book "kestrel/bv-lists/bvplus-list" :dir :system)
(local (include-book "kestrel/bv/arith" :dir :system))
(include-book "kestrel/bv-lists/packing" :dir :system) ;bring in some stuff in axe-runes
(include-book "unify-term-and-dag-with-name")
(include-book "kestrel/bv-arrays/bv-array-conversions" :dir :system)
(include-book "lists-axe")
(include-book "group-axe")
(include-book "dag-to-term-with-lets")
(include-book "dag-size") ; for make-size-array-for-dag-array
(include-book "replace-node")
(include-book "prover2")
(include-book "extract-dag-array")
(local (include-book "kestrel/lists-light/append" :dir :system))
(include-book "kestrel/lists-light/last-elem" :dir :system)
;(include-book "kestrel/lists-light/update-nth" :dir :system) ;brings in consp-of-update-nth
(include-book "kestrel/lists-light/cons" :dir :system) ;for equal-of-cons
;(include-book "kestrel/lists-light/cdr" :dir :system) ;for cdr-iff
(include-book "kestrel/utilities/make-tuple" :dir :system)
(include-book "kestrel/lists-light/all-same-eql" :dir :system)
(local (include-book "kestrel/acl2-arrays/acl2-arrays" :dir :system))
(local (include-book "kestrel/alists-light/alistp" :dir :system))
(local (include-book "kestrel/typed-lists-light/rational-listp" :dir :system))
(local (include-book "kestrel/typed-lists-light/pseudo-term-listp" :dir :system))
(local (include-book "kestrel/typed-lists-light/nat-listp" :dir :system))
(local (include-book "kestrel/lists-light/reverse" :dir :system))
(local (include-book "kestrel/lists-light/member-equal" :dir :system))
(local (include-book "kestrel/lists-light/nthcdr" :dir :system))
(local (include-book "kestrel/arithmetic-light/mod" :dir :system))
(local (include-book "kestrel/arithmetic-light/mod-and-expt" :dir :system))
(local (include-book "kestrel/arithmetic-light/expt2" :dir :system))
(local (include-book "kestrel/utilities/acl2-count" :dir :system))
(local (include-book "kestrel/utilities/explode-atom" :dir :system))
(local (include-book "kestrel/utilities/merge-sort-symbol-less-than" :dir :system))
(local (include-book "kestrel/utilities/split-list-fast" :dir :system))
(local (include-book "kestrel/arithmetic-light/types" :dir :system))
(local (include-book "merge-sort-less-than-rules"))
(local (include-book "kestrel/terms-light/sublis-var-simple-proofs" :dir :system))

(local (in-theory (e/d (true-listp-when-nat-listp-rewrite)
                       (acl2-count symbol-alistp default-car default-cdr))))

(defthm not-<-of-maxelem-and-nth
  (implies (and (< n (len x))
                (natp n))
           (not (< (maxelem x) (nth n x))))
  :hints (("Goal" :in-theory (enable maxelem (:i nth)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;move
(defthm <-of-acl2-count-of-g-aux-and-acl2-count
  (implies (and (not (ifrp rec))
                (set::in key (key-set rec))
                ;key
                )
           (< (acl2-count (g-aux key rec))
              (acl2-count rec)))
  :hints (("Goal" :in-theory (enable g-aux key-set))))

;move
(defthm <-of-acl2-count-of-g-and-acl2-count
  (implies (and (set::in key (rkeys rec))
                key)
           (< (acl2-count (g key rec)) (acl2-count rec)))
  :hints (("Goal" :expand (set::in key '(nil))
           :in-theory (enable g acl2->rcd g-aux rkeys))))

;move
(defthm <-of-acl2-count-of-g-and-acl2-count-linear
  (implies (and (set::in key (rkeys rec))
                key)
           (< (acl2-count (g key rec)) (acl2-count rec)))
  :rule-classes :linear
  :hints (("Goal" :expand (set::in key '(nil))
           :in-theory (enable g acl2->rcd g-aux rkeys))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; move, so we can use it in other tools?
;; Can throw an error or print a warning if the vars disagree.  Returns nil.
(defun maybe-check-dag-vars (check-vars
                             dag-or-quotep1
                             dag-or-quotep2
                             ctx)
  (declare (xargs :guard (and (member-eq check-vars '(t nil :warn))
                              (or (myquotep dag-or-quotep1)
                                  (pseudo-dagp dag-or-quotep1))
                              (or (myquotep dag-or-quotep2)
                                  (pseudo-dagp dag-or-quotep2))
                              (symbolp ctx) ; at least for now
                              )))
  (if (not check-vars)
      nil ; no check
    (let* ((vars1 (if (quotep dag-or-quotep1) nil (dag-vars dag-or-quotep1)))
           (vars2 (if (quotep dag-or-quotep2) nil (dag-vars dag-or-quotep2)))
           ;; (- (cw "Variables in DAG1: ~x0~%" vars1))
           ;; (- (cw "Variables in DAG2: ~x0~%" vars2))
           ;; can use equal here since the lists are sorted and duplicate-free:
           (vars-differp (not (equal vars1 vars2))))
      (if (not vars-differp)
          nil
        (progn$ (and (not (subsetp-eq vars1 vars2)) ; todo: optimize these set operations, given that the lists are sorted
                     (prog2$ (and (eq :warn check-vars) (cw "WARNING: "))
                             (cw "The first DAG has vars, ~x0, not in the second DAG.~%" (set-difference-eq vars1 vars2))))
                (and (not (subsetp-eq vars2 vars1))
                     (prog2$ (and (eq :warn check-vars) (cw "WARNING: "))
                             (cw "The second DAG has vars, ~x0, not in the first DAG.~%" (set-difference-eq vars2 vars1))))
                (if (eq :warn check-vars)
                    nil ; no error
                  (er hard? ctx "Mismatch in DAG vars (see above).")))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;try to deprecate?
(defund axe-prover-hints (runes
                         rule-alist ;was rules
                         interpreted-function-alist analyzed-function-table)
  (s :runes runes
     (s :rule-alist rule-alist
        (s :interpreted-function-alist interpreted-function-alist
           (s :analyzed-function-table analyzed-function-table ;think about this
              nil)))))

;looks for the if nest that results from the macro OR
;now also handles boolor ! ;Fri Feb 12 12:54:05 2010
(defund get-disjuncts-from-term (term)
  (if (and (call-of 'if term)
           (equal (farg1 term) (farg2 term)))
      (cons (farg1 term) ;should we dive into this term too?
            (get-disjuncts-from-term (farg3 term)))
    (if (call-of 'boolor term)
        (append (get-disjuncts-from-term (farg1 term))
                (get-disjuncts-from-term (farg2 term)))
      (list term))))

;returns a list of conjuncts (terms) whose conjunction is equivalent to (not term)
;only preserves iff, not equality?
(defun conjuncts-for-negation (term)
  ;;uses the fact that (not (or x y)) is (and (not x) (not y))
  (negate-terms (get-disjuncts-from-term term)))

;special handling of if nests that represent conjunctions (they get printed as ands, which is clearer and can cause much less indenting)
(defun print-term-nice (term)
  (let ((term (if (and (call-of 'if term)
                       (equal *nil* (farg3 term)))
                  `(and ,@(get-conjuncts term))
                term)))
    (cw "~x0" term)))

;dup
;use defmap?
(defun enlist-all (items)
  (if (endp items)
      nil
      (cons (list (car items))
            (enlist-all (cdr items)))))

;deprecated?
(defun mypackn1 (lst)
  (declare (xargs :guard (atom-listp lst)))
  (cond ((atom lst) nil)
        (t (append (explode-atom (car lst) 10)
                   (mypackn1 (cdr lst))))))

;deprecated?
(defund mypackn (lst)
  (declare (xargs :guard (atom-listp lst)))
  (let ((ans (intern (coerce (mypackn1 lst) 'string)
                     "ACL2")))
       ans))

;deprecate?
(defun mypackn-list (lsts)
  (if (endp lsts)
      nil
    (cons (mypackn (car lsts))
          (mypackn-list (cdr lsts)))))

;move
;requires that the keys are eq-able
(defund consistent-alists (alist1 alist2)
  (declare (xargs :guard (and (symbol-alistp alist1)
                              (symbol-alistp alist2))
                  :guard-hints (("Goal" :in-theory (enable alistp-guard-hack)))
                  ))
  (if (endp alist1)
      t
    (let* ((entry (car alist1))
           (key (car entry))
           (entry-in-list2 (assoc-eq key alist2)))
      (if (or (null entry-in-list2)
              (equal (cdr entry)
                     (cdr entry-in-list2)))
          (consistent-alists (cdr alist1) alist2)
        nil))))

;dup
;doesn't go inside lambda bodies - is that okay?
;not exhaustive!
;reorder params to more closely resemble sublis-var-simple?
(mutual-recursion
 (defun replace-in-term2 (term alist)
   (declare (xargs :guard (and (pseudo-termp term)
                               (alistp alist))))
   (let* ((match (assoc-equal term alist)))
     (if match
         (cdr match) ;could recur on this...
       (if (atom term)
           term
         (if (quotep term)
             term
           (cons (ffn-symb term)
                 (replace-in-terms2 (fargs term) alist)))))))

 (defun replace-in-terms2 (terms alist)
   (declare (xargs :guard (and (pseudo-term-listp terms)
                               (alistp alist))))
   (if (endp terms)
       nil
     (cons (replace-in-term2 (car terms) alist)
           (replace-in-terms2 (cdr terms) alist)))))

;dup
(defun my-pack-list (item lst)
  (if (endp lst)
      nil
    (cons (pack$ item (car lst))
          (my-pack-list item (cdr lst)))))

(defttag axe) ; for set-register-invariant-risk

(set-register-invariant-risk nil) ;potentially dangerous but needed for execution speed

;; ;reconses the list, but oh well
;; (defun drop-last (lst)
;;   (butlast lst 1))

;; (defmap-simple drop-last)

(local (in-theory (disable NAT-LISTP))) ;prevent inductions

;; can combine names like *foo-spec-dag* and *foo-java-dag*
;; (choose-equality-proof-name '*foo-spec-dag* '*foo-java-dag*)
;todo: move up
(defund choose-equality-proof-name (name dag-or-term-form1 dag-or-term-form2 wrld)
  (declare (xargs :guard (and (symbolp name)
                              (plist-worldp wrld))
                  :mode :program ; todo, because of fresh-name-in-world-with-$s
                  ))
  (let ((desired-name (if (eq :auto name)
                          (if (and (symbolp dag-or-term-form1)
                                   (symbolp dag-or-term-form2)
                                   (starts-and-ends-with-starsp dag-or-term-form1)
                                   (starts-and-ends-with-starsp dag-or-term-form2))
                              (let ((name1 (strip-stars-from-name dag-or-term-form1))
                                    (name2 (strip-stars-from-name dag-or-term-form2)))
                                ;; todo: remove "-dag" from the names here:
                                ;; todo: handle common parts of the names here, like foo in *foo-spec-dag* and *foo-java-dag*:
                                (pack$ name1 '-equal- name2))
                            ;; Just use a generic default name:
                            'main-miter)
                        ;; not :auto, so use the specified name:
                        name)))
    ;; avoid name clashes, since we may use the same name for the theorem:
    (fresh-name-in-world-with-$s desired-name nil wrld)))

;; todo
;; (defthm symbolp-of-choose-equality-proof-name
;;   (symbolp (choose-equality-proof-name name dag-or-term-form1 dag-or-term-form2 wrld)))

(defund choose-proof-name (name dag-or-term-form wrld)
  (declare (xargs :guard (and (symbolp name)
                              (plist-worldp wrld))
                  :mode :program ; todo, because of fresh-name-in-world-with-$s
                  ))
  (let ((desired-name (if (eq :auto name)
                          (if (and (symbolp dag-or-term-form) ; for example, *foo-dag*
                                   (starts-and-ends-with-starsp dag-or-term-form))
                              ;; todo: remove "-dag" from the name here:
                              (pack$ (strip-stars-from-name dag-or-term-form) '-proof)
                            ;; Just use a generic default name:
                            'main-proof)
                        ;; not :auto, so use the specified name:
                        name)))
    ;; avoid name clashes, since we may use the same name for the theorem:
    (fresh-name-in-world-with-$s desired-name nil wrld)))

;; (mutual-recursion
;;  (defun first-nodenum-aux-lst (objects)
;;    (if (atom objects)
;;        nil
;;      (or (first-nodenum-aux (car objects))
;;          (first-nodenum-aux-lst (cdr objects)))))

;;  ;; if object is a ground-term this should return nil
;;  (defun first-nodenum-aux (object)
;;    (if (atom object)
;;        (if (symbolp object)
;;            nil ;it's a variable
;;          ;;it's a nodenum, so return it
;;          object)
;;      (if (eq 'quote (ffn-symb object))
;;          nil ;it's a quoted constant
;;        (first-nodenum-aux-lst (fargs object))))))

;; (verify-guards first-nodenum-aux)

;; ;; object is a tree with leaves that are quoted constants, variables, or nodenums
;; ;; usually there will be a nodenum somewhere in the tree, and we use the first one found as the index into the memoization
;; (defun first-nodenum (object)
;;   (let ((nodenum (first-nodenum-aux object)))
;;     (if nodenum
;;         nodenum
;;       ;;object contains no nodenums
;;       0)))  ;hope it's okay to use 0 for vars and ground terms - BOZO bad since there are lots of constants... don't store them in memoization (or only store certain ones that are slow to compute)

;; (skip -proofs (verify-guards first-nodenum))

;; ;move
;; (defun standard-assumptions (local-0-array-size local-1-array-size local-2-array-size)
;;   (declare (xargs :mode :program))
;;   `((equal (get-field (jvm::nth-local '0 locals) ',(array-contents-pair) initial-heap)
;;            ,(bit-blasted-symbolic-array 'key local-0-array-size 8))
;;     (equal (get-field (jvm::nth-local '1 locals) ',(array-contents-pair) initial-heap)
;;            ,(bit-blasted-symbolic-array 'in local-1-array-size 8))
;;     (equal (get-field (jvm::nth-local '2 locals) ',(array-contents-pair) initial-heap)
;;            ,(bit-blasted-symbolic-array 'out local-2-array-size 8))
;;     (array-refp-aux (jvm::nth-local '0 locals)
;;                     (cons ',local-0-array-size 'nil)
;;                     ':byte
;;                     initial-heap 'nil)
;;     (array-refp-aux (jvm::nth-local '1 locals)
;;                     (cons ',local-1-array-size 'nil)
;;                     ':byte
;;                     initial-heap 'nil)
;;     (array-refp-aux (jvm::nth-local '2 locals)
;;                     (cons ',local-2-array-size 'nil)
;;                     ':byte
;;                     initial-heap 'nil)))

;; (defun add-vals-to-test-case (vars vals acc)
;;   (if (endp vars)
;;       acc
;;     (add-vals-to-test-case (cdr vars) (cdr vals) (acons-fast (car vars) (car vals) acc))))

;; (skip -proofs (verify-guards add-vals-to-test-case))

;; (defun split-test-case (test-case var new-vars)
;;   (if (endp test-case)
;;       nil
;;     (let* ((entry (car test-case))
;;            (this-var (car entry)))
;;       (if (eq this-var var)
;;           (add-vals-to-test-case new-vars (cdr entry) (split-test-case (cdr test-case) var new-vars))
;;         (cons entry (split-test-case (cdr test-case) var new-vars))))))

;; (skip -proofs (verify-guards split-test-case))

;; ;make tail-rec?
;; (defun split-test-cases (test-cases var new-vars)
;;   (if (endp test-cases)
;;       nil
;;     (cons (split-test-case (car test-cases) var new-vars)
;;           (split-test-cases (cdr test-cases) var new-vars))))

;; (skip -proofs (verify-guards split-test-cases))

;; ;returns (mv nodenum-of-disjunction dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;; ;gen to make any a/c nest?
;; (defun make-disjunction (disjunct-nodenums dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;   (if (endp disjunct-nodenums)
;;       (mv 'error nil nil nil nil nil)
;;     (if (endp (cdr disjunct-nodenums))
;;         (mv (car disjunct-nodenums) dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;       (mv-let (nodenum-of-disjunction-of-cdr dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;               (make-disjunction (cdr disjunct-nodenums)
;;                                 dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;               (add-function-call-expr-to-dag-array
;;                'boolor `(,(car disjunct-nodenums)
;;                         ,nodenum-of-disjunction-of-cdr)
;;                dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)))))


;ffixme this assumes there is only one call!!
;could do better?
(mutual-recursion
 (defun call-appears-at-top-level (expr name)
   (declare (xargs :guard (and (pseudo-termp expr)
                               (symbolp name))))
   (if (atom expr)
       nil
     (let* ((fn (ffn-symb expr)))
       (if (eq 'quote fn)
           nil
         (if (eq fn name)
             t
           (if (eq 'if fn)
               (or (call-appears-at-top-level (second (fargs expr)) name)
                   (call-appears-at-top-level (third (fargs expr)) name))
             (if (consp fn) ;;it's a lambda
                 (or (call-appears-at-top-level (third fn) name)
                     ;;(call-appears-at-top-level-lst (fargs expr) name) ;what if we bind the call to a var and then return it
                     )
               ;;if there is a recursive call in expr, it is inside another function call:
               nil)))))))

 (defun call-appears-at-top-level-lst (exprs name)
   (declare (xargs :guard (and (pseudo-term-listp exprs)
                               (symbolp name))))
   (if (endp exprs)
       nil
     (or (call-appears-at-top-level (car exprs) name)
         (call-appears-at-top-level-lst (cdr exprs) name)))))

;not quite right (assumes there is only 1 call)
;what does this enforce about the if-nest?
(defun tail-recursivep (name state)
  (declare (xargs :guard (symbolp name)
                  :stobjs state))
  (let* ((props (getprops name 'current-acl2-world (w state)))
         (body (lookup-eq 'unnormalized-body props)))
    (if (or (not body)
            (not (pseudo-termp body)) ;not possible
            )
        nil ;(hard-error 'tail-recursivep "No body for ~x0." (acons #\0 name nil))
    (call-appears-at-top-level body name))))

;ffixme what about packing functions?  we may not want to generate lemmas about them..
;todo: rename to end in "p"
(defun is-a-rec-fn-to-handle (fn state)
  (declare (xargs :stobjs state))
  (and (symbolp fn) ;excludes lambdas (fixme but lambdas should not appear in dags, so drop this?)
       (not (member-eq fn *built-in-fns*))
       (recursive-functionp fn state)))

;fixme what about lambdas?
(defun is-a-call-of-a-rec-fn-to-handle (expr state)
  (declare (xargs :stobjs state))
  (and (consp expr)
       (let ((fn (ffn-symb expr)))
         (is-a-rec-fn-to-handle fn state))))

;find rec-fn nodes at or below index
;now only returns nodes that are tagged
(defun filter-rec-fn-nodes2 (index dag-array-name dag-array tag-array-name tag-array state)
  (declare (xargs :guard (and (array1p dag-array-name dag-array)
                              (array1p tag-array-name tag-array)
                              (integerp index)
                              (< index (alen1 dag-array-name dag-array))
                              (< index (alen1 tag-array-name tag-array)))
                  :measure (nfix (+ 1 index))
                  :stobjs state))
  (if (not (natp index))
      nil
    (let ((tag (aref1 tag-array-name tag-array index)))
      (if (not tag)
          (filter-rec-fn-nodes2 (+ -1 index) dag-array-name dag-array tag-array-name tag-array state)
        (let* ((expr (aref1 dag-array-name dag-array index)))
          (if (is-a-call-of-a-rec-fn-to-handle expr state)
              (cons index (filter-rec-fn-nodes2 (+ -1 index) dag-array-name dag-array tag-array-name tag-array state))
            (filter-rec-fn-nodes2 (+ -1 index) dag-array-name dag-array tag-array-name tag-array state)))))))

;; (mutual-recursion
;;  (defun contains-a-lambda (term)
;;    (if (atom term)
;;        nil
;;      (let ((fn (ffn-symb term)))
;;        (if (eq fn 'quote)
;;            nil
;;          (if (consp fn)
;;              t ;it's a lambda
;;            (contains-a-lambda-list (fargs term)))))))
;;  (defun contains-a-lambda-list (terms)
;;    (if (endp terms)
;;        nil
;;      (or (contains-a-lambda (car terms))
;;          (contains-a-lambda-list (cdr terms))))))

;; ;requires fn to be a symbol and so doesn't support lambdas
;; (mutual-recursion
;;  (defun expr-with-no-call (fn expr)
;;    (declare (xargs :measure (acl2-count expr)
;;                    :guard (and (symbolp fn)
;;                                (pseudo-termp expr))))
;;    (cond ((variablep expr) t)
;;          ((fquotep expr) t)
;;          (t (and (not (eq fn (ffn-symb expr)))
;;                  (exprs-with-no-call fn (fargs expr))))))

;;  (defun exprs-with-no-call (fn exprs)
;;    (declare (xargs :measure (acl2-count exprs)
;;                    :guard (and (symbolp fn)
;;                                (pseudo-term-listp exprs))))
;;    (if (atom exprs)
;;        t
;;      (and (expr-with-no-call fn (car exprs))
;;           (exprs-with-no-call fn (cdr exprs))))))

;requires fn to be a symbol (not a lambda)
;does handle lambdas in expr

(defun lambda-surrounded-fn-call-with-no-other-calls-of-fnp (fn term)
  (declare (xargs :guard (and (symbolp fn)
                              (not (equal fn 'quote))
                              (pseudo-termp term))))
  (or (and (call-of fn term)
           (not (some-expr-calls-fn fn (fargs term)))
           ;;(exprs-with-no-call fn (fargs term))
           )
      (and (consp term)
           (consp (car term)) ;lambda application
           (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn (third (car term))) ;;check the lambda body
           (not (some-expr-calls-fn fn (fargs term)))
           ;;(exprs-with-no-call fn (fargs term))
           )))

;handles lambdas in certain places
(defun base-cases-in-ite (term fn)
  (declare (xargs :guard (and (symbolp fn)
                              (not (equal fn 'quote))
                              (pseudo-termp term))))
  (if (not (call-of 'if term))
      (if (not (expr-calls-fn fn term))
          (list term) ;it's a base case
        (if (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term) ;overkill to check this?
            nil ;;recursive call
          (hard-error 'base-cases-in-ite "Expected an ITE or a base-case or a recursive call but got ~x0."
                      (acons #\0 term nil))))
    ;;it's an ITE:
    (let* ( ;(test (first (fargs term)))
           (then-part (second (fargs term)))
           (else-part (third (fargs term))))
      ;;does not process the exit-test
      (append (base-cases-in-ite then-part fn)
              (base-cases-in-ite else-part fn)))))

;the items can appear in any order, but there can't be duplicates
(defun cons-nest-of-unique-itemsp (nest items)
  (declare (xargs :guard (and (pseudo-termp nest)
                              (pseudo-term-listp items))))
  (or (equal *nil* nest)
      (and (call-of 'cons nest)
           (member-equal (first (fargs nest)) items)
           (cons-nest-of-unique-itemsp (second (fargs nest)) (remove-equal (first (fargs nest)) items)))))

(defun trivial-base-case-termp (term formals)
  (declare (xargs :guard (and (pseudo-termp term)
                              (symbol-listp formals))))
  (if (consp term)
      (cons-nest-of-unique-itemsp term formals)
    (member-eq term formals)))

(defun ite-nest-with-base-cases-and-lambda-wrapped-rec-callp (fn term)
  (declare (xargs :guard (and (symbolp fn)
                              (not (equal fn 'quote))
                              (pseudo-termp term))))
  (if (not (expr-calls-fn fn term))
      ;; it's a base case:
      t
    (if (call-of 'if term)
        ;;it's an ITE:
        (let* ((test (first (fargs term)))
               (then-part (second (fargs term)))
               (else-part (third (fargs term))))
          (and (not (expr-calls-fn fn test))
               (ite-nest-with-base-cases-and-lambda-wrapped-rec-callp fn then-part)
               (ite-nest-with-base-cases-and-lambda-wrapped-rec-callp fn else-part)))
      ;;it must be a lambda-wrapped rec call (ffixme what if the lambda binds a var to the rec call and the returns it?)
      (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term))))

;;We peel off the base case logic if there is more than one base case (even if they are all the same), or if the single base case is non-trivial.
;;what if there are multiple, identical base cases? we still want to combine them (which the peeling off code handles), right?
;; FN should be a defined, tail-recursive function (with a single recursive call?).
;this routine is now a bit more flexible about lambdas
;is the result guaranteed to be a nice tail rec fn?
(defun need-to-peel-off-base-casep (fn state)
  (declare (xargs :guard (and (symbolp fn)
                              (not (eq 'quote fn)))
                  :stobjs state
                  :verify-guards nil ; todo, need properties of BASE-CASES-IN-ITE
                  ))
  (let* ((formals (fn-formals fn (w state)))
         (body (fn-body fn t (w state))))
    (and (ite-nest-with-base-cases-and-lambda-wrapped-rec-callp fn body) ;allows lambdas in certain places (must not intervene in the ITE nest) ffixme relax this restriction?!
         ;;(not (contains-a-lambda body)) ;ffffixme
         (let ((base-case-terms (base-cases-in-ite body fn)))
           (or (< 1 (len base-case-terms))
               (not (trivial-base-case-termp (first base-case-terms) formals)))))))
;if there is more than 1 base case, they all need to be the same (otherwise, generating theorems about the function
;would not work well [consider a function that returns param0 in some cases and param1 in some cases - what do we say about its type?])


;; ;includes the exit-tests as well
;; ;handles lambdas in certain places
;; (mutual-recursion
;;  (defun get-base-case-and-exit-test-terms (term fn)
;;    (if (not (expr-calls-fn fn term)) ;(expr-with-no-call fn term)
;;        ;;it's a base case:
;;        (list term)
;;      (if (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term) ;;(call-of fn term)
;;          ;;recursive call:
;;          nil
;;        ;must be an ITE (other fn calls are disallowed in the input to this function?  check that?
;;        (get-base-case-and-exit-test-terms-list (fargs term) fn))))

;;  (defun get-base-case-and-exit-test-terms-list (terms fn)
;;    (if (endp terms)
;;        nil
;;      (append (get-base-case-and-exit-test-terms (car terms) fn)
;;              (get-base-case-and-exit-test-terms-list (cdr terms) fn)))))

;; ;doesn't touch the if tests
;; ;fffixme doesn't handle lets
;; ;also renames the recursive calls
;; ;also changes the name of the recursive call
;; (defun fixup-body-for-peeling-off (term fn new-fn base-case-replacement)
;;   (if (not (call-of 'if term))
;;       (if (not (expr-calls-fn fn term))  ;;(expr-with-no-call fn term)
;;           base-case-replacement          ;it's a base case
;;         (if (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term)
;;             ;;recursive call:
;;             (rename-fn fn new-fn term) ;;(cons new-fn (fargs term))
;;           (hard-error 'fixup-body-for-peeling-off "Expected an ITE or a base-case or a recursive call but got ~x0."
;;                       (acons #\0 term nil))))
;;     ;;it's an ITE:
;;     (let* ((test (first (fargs term)))
;;            (then-part (second (fargs term)))
;;            (else-part (third (fargs term))))
;;       `(if ,test
;;            ,(fixup-body-for-peeling-off then-part fn new-fn base-case-replacement)
;;          ,(fixup-body-for-peeling-off else-part fn new-fn base-case-replacement)))))

;; (mutual-recursion
;;  (defun fixup-base-cases-and-exit-tests-in-ite (term fn formal-replacement-alist)
;;    (if (call-of 'if term) ;handle other kinds of if?  maybe not..
;;        ;;it's an ITE:
;;        (let* ((test (first (fargs term)))
;;               (then-part (second (fargs term)))
;;               (else-part (third (fargs term))))
;;          `(if ,(replace-in-term2 test formal-replacement-alist)
;;               ,(fixup-base-cases-and-exit-tests-in-ite then-part fn formal-replacement-alist)
;;             ,(fixup-base-cases-and-exit-tests-in-ite else-part fn formal-replacement-alist)))
;;      (if (not (expr-calls-fn fn term)) ;;(expr-with-no-call fn term)
;;          ;;it's a base case -- could just replace vars (then not going inside lambda bodies would be the right thing)?
;;          (replace-in-term2 term formal-replacement-alist)
;;        (if (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term)
;;            ':irrelevant ;;recursive call
;;          (hard-error 'fixup-base-cases-and-exit-tests-in-ite "Expected an ITE or a base-case or a possibly-lambda-wrapped recursive call but got ~x0."
;;                      (acons #\0 term nil)))))))

;; ;turn (if test1 x (if test2 x y)) into (if (or test1 test2) x y)
;; ;only handles top level ifs
;; (skip -proofs
;;  (defun combine-adjacent-ifs (term)
;;    (if (atom term)
;;        term
;;      (let ((fn (ffn-symb term)))
;;        (if (not (eq 'if fn))
;;            term
;;          ;;it's an if:
;;          (if (and (call-of 'if (fourth term))
;;                   (equal (third term)
;;                          (third (fourth term))))
;; ;combine:
;; ;I want to use boolor here, but i guess the proof will then need to know that the things being ored are predicates? not sure.. maybe just boolor-of-nil
;;              (combine-adjacent-ifs `(if (boolor ;or
;;                                          ,(second (fourth term))
;;                                             ,(second term) ;this one is likely to also be an if, so we put it last
;;                                             )
;;                                         ,(third term)
;;                                       ,(fourth (fourth term))))
;;            `(if ,(second term) ;should we recur on this?
;;                 ,(combine-adjacent-ifs (third term))
;;               ,(combine-adjacent-ifs (fourth term)))))))))

(defun make-nth-terms-rev (terms-left term)
  (declare (type (integer 0 *) terms-left))
  (if (zp terms-left)
      nil
    (cons `(nth ',(+ -1 terms-left) ,term)
          (make-nth-terms-rev (+ -1 terms-left) term))))

(defun make-nth-terms (terms-left term)
  (declare (type (integer 0 *) terms-left))
  (reverse (make-nth-terms-rev terms-left term)))

;reuses an existing theorem of that name if its body is identical
;returns (mv actual-name state)
;can't call this make-defthm due to a name clash with books/tools/remove-hyps
(defun my-make-defthm (desired-name body hints state)
  (declare (xargs :stobjs state
                  :mode :program ; because this calls submit-event
                  ))
  (let* ((props (getprops desired-name 'current-acl2-world (w state)))
         (untranslated-theorem (lookup-eq 'untranslated-theorem props)))
    (if (equal untranslated-theorem body)
        (prog2$ (cw "Reusing pre-existing defthm ~x0.~%" desired-name)
                (mv desired-name state))
      (let* ((actual-name (packnew desired-name))
             (state (submit-event-brief `(defthm ,actual-name ,body :hints ,hints) state))) ;fixme what about the otf-flg?
        (mv actual-name state)))))

(defun drop-unmentioned-vars-and-their-terms (vars terms mentioned-vars vars-acc terms-acc)
  (if (endp vars)
      (mv (reverse vars-acc)
          (reverse terms-acc))
    (let ((var (car vars)))
      (if (member-eq var mentioned-vars)
          (drop-unmentioned-vars-and-their-terms (cdr vars) (cdr terms) mentioned-vars
                                                 (cons var vars-acc)
                                                 (cons (car terms) terms-acc))
        (drop-unmentioned-vars-and-their-terms (cdr vars) (cdr terms) mentioned-vars
                                               vars-acc
                                               terms-acc)))))

(defun get-arg-n-allows-lambdas (arg-num fn term)
  (if (atom term)
      (hard-error 'get-arg-n-allows-lambdas "unexpected thing." nil)
    (if (call-of fn term)
        (nth arg-num (fargs term))
      (if (not (and (consp term)
                    (consp (car term))))
          (hard-error 'get-arg-n-allows-lambdas "unexpected thing2." nil)
        ;;must be a lambda:
        (let* ((lambda-part (first term))
               (formals (second lambda-part))
               (body (third lambda-part))
               (body (get-arg-n-allows-lambdas arg-num fn body))
               (actuals (fargs term))
               (vars-in-body (get-vars-from-term body))
               )
          (mv-let (formals actuals)
                  (drop-unmentioned-vars-and-their-terms formals actuals vars-in-body nil nil)
                  (if (equal formals actuals)
                      body
                  `((lambda ,formals ,body) ,@actuals))))))))

(defun get-function-args-allows-lambdas-aux (arg-num arity fn term)
  (declare (xargs :measure (+ 1 (nfix (- arity arg-num)))))
  (if (or (not (natp arg-num))
          (not (natp arity))
          (<= arity arg-num))
      nil
    (cons (get-arg-n-allows-lambdas arg-num fn term)
          (get-function-args-allows-lambdas-aux (+ 1 arg-num) arity fn term))))

;term is a call to fn, perhaps surrounded be a lambda nest (fffixme for a given argument to fn some of the bindings in the lambda nest may be irrelevant?)
(defun get-function-args-allows-lambdas (fn arity term)
  (get-function-args-allows-lambdas-aux 0 arity fn term))

(defun getprops-non-nil (fn state)
  (declare (xargs :guard (symbolp fn)
                  :stobjs state))
  (let ((result (getprops fn 'current-acl2-world (w state))))
    (if result
        result
      (er hard? 'getprops-non-nil "couldn't get props for ~x0." fn))))

;recognizes tail recursive functions of the form:
;; (defun <fn> (param0 param1 ...) (if <exit-test-expr> <base-case-expr> (<fn> <update-expr0> <update-expr1> ...)))
;; where <exit-test-expr>, <base-case-expr>, and the <updated-expr>s don't contain any recursive calls.
;; All functions generated by the decompiler are of this form (in fact, they are more stylized: one formal [named params], and a no-op base case expr?).
;; Returns (list nice-tail-functionp exit-test-expr base-case-expr update-expr-list)
;;fixme allow the then and else branches to be in the other order?
;;fixme allow multiple base cases (merge by making an ITE?) and multiple recursive calls (merge using ITE)
;;ffixme what about lets in the function body!
;fixme could just return nil in the case that it's not a nice tail rec fn!
;fixme note that the update-expr-list may contain the same call of the update function in each update-expr (for example, call is-a-nice-tail-function on process-blocks for md5)
;--consider trying to recover that sharing?!
(defun is-a-nice-tail-function (fn state)
  (declare (xargs :stobjs state
                  :verify-guards nil))
  (let* ((props (getprops-non-nil fn state))
         (body (lookup-eq 'unnormalized-body props)))
    (if (not body) ;if it's a primitive function...
        (list nil nil nil nil)
      (let* ((formals (lookup-eq-safe 'formals props)))
        (if (and (<= 1 (len formals))
                 (call-of 'if body)
                 (let* ((fargs (fargs body))
                        (exit-test (first fargs)))
                   (and (not (expr-calls-fn fn exit-test)) ;;(expr-with-no-call fn exit-test)
                        (let ((base-case (second fargs)))
                          (and (not (expr-calls-fn fn base-case)) ;;(expr-with-no-call fn base-case)
                               (let ((rec-call (third fargs))) ;may have surrounding lambdas
                                 (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn rec-call)))))))
            (list t
                  (first (fargs body))       ;exit-test-expr
                  (second (fargs body))      ;base-case-expr
                  (get-function-args-allows-lambdas fn (len formals) (third (fargs body))) ;update-exprs
                  )
          (list nil nil nil nil))))))

(defun make-body-schema (term fn)
  (if (not (expr-calls-fn fn term)) ;it's a base case
      :base
    (if (lambda-surrounded-fn-call-with-no-other-calls-of-fnp fn term) ;it's a recursive call
        :rec
      (if (call-of 'if term)
          `(if ,(farg1 term) ;ffixme should this be processed?  i think not...
               ,(make-body-schema (farg2 term) fn)
             ,(make-body-schema (farg3 term) fn))
        (hard-error 'make-body-schema "Unexpected thing (expected an IF nest where every branch is a base case or (possibly-lambda-wrapped) call of ~x1:~% ~x0."
                    (acons #\0 term (acons #\1 fn nil)))))))


;processes term and schema in sync
;returns a tree that's the same as term, except any ite with a branch of :rec in the schema is replaced by the other branch (and so on, up the tree)
;there must be at least one ITE branch that is a base case
(defund make-new-base-case-with-schema (term schema)
  (if (eq :base schema)
      term
    (if (eq :rec schema)
        :dropme ;;should get dropped by the caller
      (if (not (call-of 'if schema))
          (hard-error 'make-new-base-case-with-schema "expected an ite" nil)
        ;;it's an ITE:
        (let* ((then-part-result (make-new-base-case-with-schema (farg2 term) (farg2 schema)))
               (else-part-result (make-new-base-case-with-schema (farg3 term) (farg3 schema))))
          (if (eq :dropme then-part-result)
              else-part-result
            (if (eq :dropme else-part-result)
                then-part-result
              `(if ,(farg1 schema)
                   ,then-part-result
                 ,else-part-result))))))))

(defund make-new-rec-case-with-schema (term schema)
  (if (eq :base schema)
      :dropme ;;should get dropped by the caller
    (if (eq :rec schema)
        term
      (if (not (call-of 'if schema))
          (hard-error 'make-new-rec-case-with-schema "expected an ite" nil)
        ;;it's an ITE:
        (let* ((then-part-result (make-new-rec-case-with-schema (farg2 term) (farg2 schema)))
               (else-part-result (make-new-rec-case-with-schema (farg3 term) (farg3 schema))))
          (if (eq :dropme then-part-result)
              else-part-result
            (if (eq :dropme else-part-result)
                then-part-result
              `(if ,(farg1 schema)
                   ,then-part-result
                 ,else-part-result))))))))

;preserves only iff, not equal!
(defun clean-up-ifs (term)
  (if (not (call-of 'if term))
      term
    (let* ((then-part (farg2 term))
           (else-part (farg3 term)))
      (if (and (equal *t* then-part)
               (equal *nil* else-part))
          ;;(if test t nil) -> test
          (clean-up-ifs (farg1 term))
      (if (and (equal *nil* then-part)
               (equal *t* else-part))
          ;;(if test nil t) -> (not test)
          `(not ,(clean-up-ifs (farg1 term)))
        `(if ,(farg1 term)
             ,(clean-up-ifs (farg2 term))
           ,(clean-up-ifs (farg3 term))))))))

;fixme put back
;; ;lots of subgoals:
;; (defevaluator if-eval if-eval-list ((if test thenpart elsepart)(not x)))

;fixme put back
;; ;just proved this because it seemed easy (but this is slow...):
;; (defthm clean-up-ifs-correct
;;   (implies (and (pseudo-termp term)
;;                 (alistp a))
;;            (iff (if-eval term a)
;;                 (if-eval (clean-up-ifs term) a)))
;; ;  :rule-classes ((:meta))
;;   :hints (("Goal" :induct (clean-up-ifs term))))

;returns state
;fixme if there is only one base case, what should this do?  now, it builds a function basically identical but with a new name?
(defun combine-base-cases-of-tail-fn (fn ;interpreted-function-alist
                                      new-fn ;the name to use for the new function
                                      lemma-name
                                      state)
  (declare (xargs :mode :program ;because this calls submit-events-brief (todo: split out the creation of the events)
                  :stobjs state))
  (let* ((formals (fn-formals fn (w state)))
         (body (fn-body fn t (w state)))
         ;;puts in :base for base cases and :rec for possibly-lambda-wrapped-recursive calls (result has the same ITE shape as body):
         (body-schema (make-body-schema body fn))
         ;;the new exit test is the processed body with t for :base and nil for :rec
         ;;ffixme could turn this into a boolor or otherwise clean up?
         (new-exit-test (replace-in-term2 body-schema (acons :base *t* (acons :rec *nil* nil))))
         ;;simplifies (if x t nil) and (if x nil t):
         (new-exit-test (clean-up-ifs new-exit-test))
         (new-base-case (make-new-base-case-with-schema body body-schema))
         ;;the new rec case is the body with any ite with a branch that would be :base replaced by the other branch (and so on, up the tree)
         (new-rec-case (make-new-rec-case-with-schema body body-schema))
         ;;now rename the function being called:
         (new-rec-case (rename-fn fn new-fn new-rec-case))
         (new-body `(if ,new-exit-test ,new-base-case ,new-rec-case))
         (state (submit-events-brief `((skip-proofs ;fixme reuse the termination argument for fn?
                                  (defun ,new-fn ,formals
                                    (declare (xargs :normalize nil))
                                    ,new-body))

                                 (defthm ,lemma-name
                                   (equal (,fn ,@formals)
                                          (,new-fn ,@formals))
                                   :hints (("Goal" :induct (,fn ,@formals)
                                            :in-theory (union-theories (theory 'minimal-theory)
                                                                       '(,fn
                                                                         ,new-fn
                                                                         (:induction ,fn)))))))
                               state)))
    state))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;TEST-CASE-ARRAY-NAME and TEST-CASE-ARRAY may be nil - fffixme what happens in that case?
;;returns the trace of the execution of the recursive function at nodenum, or nil if nodenum isn't used on this test case (but only if TEST-CASE-ARRAY is non-nil)
;fixme - handle the case when too many cases are skipped!? done elsewhere?
(defun get-trace-for-node (nodenum dag-array-name dag-array interpreted-function-alist
                                   test-case ;the test case
                                   test-case-array-name
                                   test-case-array)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-casep test-case)
                              (array1p test-case-array-name test-case-array)
                              (< nodenum (alen1 test-case-array-name test-case-array)))))
  (let* (;(dummy (cw "(debug"))
         (value (and test-case-array (aref1 test-case-array-name test-case-array nodenum))) ;fixme slow array-warning?
         ;(dummy2 (cw "debug)"))
         )
;    (declare (ignore dummy dummy2))
    (if (eq :unused value) ;ffixme what if we aren't keeping test cases but the value will be :unused when we compute it?
        (prog2$ nil ;(cw "Skipping trace for which the node is :unused.~%")
                nil)
      (let ((expr (aref1 dag-array-name dag-array nodenum)))
        (if (or (not (consp expr))
                (eq 'quote (ffn-symb expr)))
            (er hard? 'get-trace-for-node "Expected a recursive function call but got ~x0" expr)
          ;;regular function call
          (let* ((fn (ffn-symb expr))
                 (dargs (dargs expr))
                 ;;first generate values for the arguments
                 (arg-vals (if test-case-array
                               ;;if we passed in a test-case-array, just look-up the arg vals
                               (get-vals-of-args dargs test-case-array-name test-case-array)
                             ;;no test-case-array was passed in, so we have to compute the whole test case:
                             (let* ((dargs-to-eval (keep-nodenum-dargs dargs)))
                               (if (not dargs-to-eval)
                                   ;; args were all constants:
                                   dargs
                                 (let (;;fffixme this may crash if the node is :unused in the whole test case:
                                       ;;should we evaluate things top-down like we do the whole miter to try to detect such cases?
                                       ;;fixme this sets unused nodes to :unused - don't bother?
                                       (test-case-array (evaluate-test-case
                                                         dargs-to-eval ;initial worklist
                                                         dag-array-name
                                                         dag-array
                                                         (prog2$ nil ;(cw "evaluating partial test case for ~x0.~%" test-case)
                                                                 test-case)
                                                         interpreted-function-alist
                                                         'test-case-array)))
                                   (get-vals-of-args dargs 'test-case-array test-case-array)))))))
            ;;evaluate and trace the recursive function call:
            (mv-let (value trace)
                    (apply-axe-evaluator-with-tracing
                     fn arg-vals interpreted-function-alist ;fn
                     )
                    (declare (ignore value)) ;compare this to the value from the array (if any?)
                    trace)))))))

;;returns (mv traces test-cases count) where test-cases are the ones on which the function is actually used
;;ffixme test-case-array-alist may be nil?
(defun get-traces-for-node-aux (test-cases nodenum dag-array-name dag-array interpreted-function-alist test-case-array-alist traces-acc test-cases-acc count)
  (declare (xargs :guard (and (test-casesp test-cases)
                              (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-case-array-alistp test-case-array-alist (+ 1 nodenum))
                              (<= (len test-cases) (len test-case-array-alist))
                              (true-listp traces-acc)
                              (true-listp test-cases-acc)
                              (natp count)
                              )
                  :guard-hints (("Goal" :expand (TEST-CASE-ARRAY-ALISTP TEST-CASE-ARRAY-ALIST (+ 1 NODENUM))))))
  (if (endp test-cases)
      (mv (reverse traces-acc) (reverse test-cases-acc) count) ;fixme drop the reverses?
    (let* ((test-case (first test-cases))
           (entry (first test-case-array-alist)) ;can be nil?
           (test-case-array-name (car entry))    ;can be nil?
           (test-case-array (cdr entry))         ;can be nil?
           (trace (get-trace-for-node nodenum dag-array-name dag-array interpreted-function-alist test-case test-case-array-name test-case-array)))
      (get-traces-for-node-aux (rest test-cases) nodenum dag-array-name dag-array
                               interpreted-function-alist
                               (rest test-case-array-alist)
                               (if trace (cons trace traces-acc) traces-acc)
                               (if trace (cons test-case test-cases-acc) test-cases-acc)
                               (if trace (+ 1 count) count)))))

;are the traces guaranteed to be non-empty? maybe so..
;;returns (mv traces test-cases count) where the test-cases returned are the ones on which the function is actually used
;;TEST-CASE-ARRAY-ALIST may be nil? or the test-cases match up with the test-case-array-alist?
;drops test-cases for which the node is unused, so TRACES and TEST-CASES should be in sync
(defun get-traces-for-node (nodenum dag-array-name dag-array interpreted-function-alist test-cases test-case-array-alist)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-casesp test-cases)
                              (test-case-array-alistp test-case-array-alist (+ 1 nodenum))
                              (<= (len test-cases) (len test-case-array-alist)))))
  (declare (type (integer 1 1073741823) nodenum)
           (xargs :guard (true-listp test-cases)))
  (progn$ (cw "  (Getting traces for node ~x0 from ~x1 test-cases.~%" nodenum (len test-cases)) ;print the fn?
          (if test-case-array-alist
              (cw "   (test-case-array-alist is non-nil.)~%")
            (cw "   (test-case-array-alist is NIL.)~%"))
          (mv-let (traces test-cases count)
                  (get-traces-for-node-aux test-cases ;(firstn 20 test-cases) ;relax guard on firstn? ;20 is arbitrary!
                                           nodenum dag-array-name dag-array interpreted-function-alist
                                           test-case-array-alist
                                           nil
                                           nil
                                           0)
                  (prog2$ (cw "   Generated ~x0 traces.)~%" count)
                          (mv traces test-cases count)))))

;;returns (list traces-for-smallnodenum traces-for-bignodenum)
;the nodenums should not be the same
(defun get-traces-for-two-nodes-aux (test-cases smallnodenum bignodenum dag-array-name dag-array interpreted-function-alist test-case-array-alist traces1-acc traces2-acc)
  (declare (xargs :guard (and (test-casesp test-cases)
                              (natp smallnodenum)
                              (natp bignodenum)
                              (<= smallnodenum bignodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 bignodenum))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-case-array-alistp test-case-array-alist (+ 1 bignodenum))
                              (<= (len test-cases) (len test-case-array-alist))
                              (TRUE-LISTP TRACES1-ACC)
                              (TRUE-LISTP TRACES2-ACC))
                  :guard-hints (("Goal" :in-theory (enable test-case-array-alistp)))))
  (if (endp test-cases)
      (list (reverse-list traces1-acc) (reverse-list traces2-acc))
    (let* ((entry (car test-case-array-alist))
           (test-case-array-name (car entry))
           (test-case-array (cdr entry))
           (test-case (first test-cases))
           (trace1 (get-trace-for-node smallnodenum dag-array-name dag-array interpreted-function-alist test-case test-case-array-name test-case-array))
           (trace2 (get-trace-for-node bignodenum dag-array-name dag-array interpreted-function-alist test-case test-case-array-name test-case-array)))
      (get-traces-for-two-nodes-aux (rest test-cases) smallnodenum bignodenum dag-array-name dag-array
                                    interpreted-function-alist
                                    (cdr test-case-array-alist)
                                    ;;requires that both nodes be used on the trace:
                                    (if (and trace1 trace2)
                                        (cons trace1 traces1-acc)
                                      traces1-acc)
                                    (if (and trace1 trace2)
                                        (cons trace2 traces2-acc)
                                      traces2-acc)))))

;;returns (list traces-for-smallnodenum traces-for-bignodenum)
;fixme is test-case-array-alist in sync with the test-cases?
;returns traces for the test cases for which both nodes are used
(defun get-traces-for-two-nodes (smallnodenum bignodenum dag-array-name dag-array interpreted-function-alist test-cases test-case-array-alist)
  (declare (type (integer 1 1073741823) smallnodenum)
           (type (integer 1 1073741823) bignodenum)
           (xargs :guard (and (test-casesp test-cases)
                              (natp smallnodenum)
                              (natp bignodenum)
                              (< smallnodenum bignodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 bignodenum))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-case-array-alistp test-case-array-alist (+ 1 bignodenum))
                              (<= (len test-cases) (len test-case-array-alist)))))
  (if (equal smallnodenum bignodenum)
      (er hard? 'get-traces-for-two-nodes "the two nodes should not be the same")
    (prog2$
     (cw "(Getting traces from ~x0 test cases:~%" (len test-cases))
     (let ((traces-pair (get-traces-for-two-nodes-aux test-cases ;can this be too many? used to use 100 (if we are taking just a few, choose a better sample?)
                                                      smallnodenum bignodenum dag-array-name dag-array interpreted-function-alist
                                                      test-case-array-alist
                                                      nil
                                                      nil)))
       (prog2$ (cw "done.)~%")
               traces-pair)))))

(defun flatten-trace (trace)
  (declare (xargs :measure (acl2-count trace)
                  :hints (("Goal" :in-theory (enable acl2-count)
                           :cases ((g :sub-traces trace))))))
  (if (endp trace)
      nil
    (let* ((args (g :args trace))
           (result (g :result trace))
           (sub-traces (g :sub-traces trace)))
      (if (<= (len sub-traces) 1) ;covers the base case of nil too
          (cons (s :args args (s :return-value result nil))
                (flatten-trace (first sub-traces)))
        (hard-error 'flatten-trace "We don't support traces where the function doesn't make exactly 1 recursive call" nil)))))

(defun flatten-traces (traces)
  (if (endp traces)
      nil
    (cons (flatten-trace (car traces))
          (flatten-traces (cdr traces)))))

;use map?
(defun len-list (items)
  (declare (xargs :guard (true-listp items)))
  (if (endp items)
      nil
    (cons (len (car items))
          (len-list (cdr items)))))

;gen the 32?
(defun get-diffs (tag lst)
  (declare (xargs :guard (integer-listp lst)))
  (if (endp lst)
      (hard-error 'get-diffs "empty lst in get-diffs on behalf of ~x0.~%" (acons #\0 tag nil))
    (if (endp (cdr lst))
        (hard-error 'get-diffs "lst with only 1 element in get-diffs on behalf of ~x0.~%" (acons #\0 tag nil))
      (if (endp (cddr lst))
          (list (bvminus 32
                         (second lst)
                         (first lst)))
        (cons (bvminus 32
                       (second lst)
                       (first lst))
              (get-diffs tag (cdr lst)))))))

;returns (mv min max)
;calls logext 32 on list elems before comparing - fixme gen
(defun min-and-max-integer-list (list min-so-far max-so-far)
  (declare (xargs :guard (and (and (integer-listp list)
                                   (integerp min-so-far)
                                   (integerp max-so-far)))))
  (if (endp list)
      (mv min-so-far max-so-far)
    (let* ((item (first list))
           (integer-value (logext 32 item))
           (max-so-far (max max-so-far integer-value))
           (min-so-far (min min-so-far integer-value)))
      (min-and-max-integer-list (rest list) min-so-far max-so-far))))



;returns (mv min max)
;calls logext 32 on list elems before comparing - fixme gen
(defun min-and-max-integer-list-list (list-of-lists min-so-far max-so-far)
  (declare (xargs :guard (and (and (integer-list-listp list-of-lists)
                                   (integerp min-so-far)
                                   (integerp max-so-far)))))
  (if (endp list-of-lists)
      (mv min-so-far max-so-far)
    (mv-let (min-so-far max-so-far)
      (min-and-max-integer-list (car list-of-lists) min-so-far max-so-far)
      (min-and-max-integer-list-list (cdr list-of-lists) min-so-far max-so-far))))

;fixme -maybe whether we want to say not greater than 43 vs less then 44 depends on whether we are generating hyps or conclusions
;fixme - gen the 32s!
;fixme should the minelem and maxelem be with regard to the field width?  i mean, if the values are usbs, of course the will be <= 0 but not sbvlt than 0 - hmmm. well maybe the logexts mean that minelem and maxelem are right..
(defun make-bounds-and-type-facts (minelem maxelem value-term size-already-asserted)
  (declare (xargs :guard (and (integerp minelem)
                              (integerp maxelem)
                              (natp size-already-asserted))))
  (if (<= 0 minelem) ;fixme use sbvlt?
      (let ((size (integer-length maxelem)))
        (append (if (eql 0 minelem)
                    nil ;in this case it's vacuous
                  (list `(not (bvlt ',size ,value-term ',minelem)))) ;we used to use 32/32/31 here
                (if (eql maxelem (+ -1 (expt 2 size)))
                    nil ;vacuous
                  (list `(not (bvlt ',size ',maxelem ,value-term))))
                (if (or (not size-already-asserted)
                        (< size size-already-asserted))
                    (list `(unsigned-byte-p ',size ,value-term))
                  nil)))
    ;;if there are negative values in the sequence:
    (append `((not (sbvlt '32 ,value-term ',(bvchop; $inline
                                             32 minelem)))
              (not (sbvlt '32 ',(bvchop ;$inline
                                        32 maxelem) ,value-term)))
            (if (or (not size-already-asserted)
                    (< 32 size-already-asserted))
                `((unsigned-byte-p '32 ,value-term)) ;fixme check this.
              nil))))

;; (defun bvplus-list-list (n x y)
;;   (if (endp x)
;;       nil
;;     (cons (bvplus-list n (car x) (car y))
;;           (bvplus-list-list n (cdr x) (cdr y)))))

;; (skip- proofs (verify-guards bvplus-list-list))

(defun nth-list-aux (n items acc)
  (declare (type (integer 0 *) n)
           (xargs :guard (and (true-listp acc)
                              (TRUE-LIST-LISTP items))))
  (if (endp items)
      (reverse acc)
    (nth-list-aux n (cdr items) (cons (nth n (car items)) acc))))

(defun nth-list (n items)
  (declare (type (integer 0 *) n)
           (xargs :guard (TRUE-LIST-LISTP items)))
  (nth-list-aux n items nil))

;dup
(defun g-list (key records)
  (declare (xargs :guard (and (true-listp records)))) ; strengthen?
  (if (endp records)
      nil
    (cons (g key (car records))
          (g-list key (cdr records)))))

;; (defun bvminus-list (n items1 items2)
;;   (if (endp items1)
;;       nil
;;     (cons (bvminus n (car items1) (car items2))
;;           (bvminus-list n (cdr items1) (cdr items2)))))

;; (skip -proofs (verify-guards bvminus-list))

(defun g-list-list (key vals)
  (declare (xargs :guard (and (true-list-listp vals)))) ; strengthen?
  (if (endp vals)
      nil
    (cons (g-list key (car vals))
          (g-list-list key (cdr vals)))))

(defun len-list-list (items)
  (declare (xargs :guard (true-list-listp items)))
  (if (endp items)
      nil
    (cons (len-list (car items))
          (len-list-list (cdr items)))))

;use a forall?
(defun true-list-list-listp (x)
  (declare (xargs :guard t))
  (cond ((atom x) (eq x nil))
        (t (and (true-list-listp (car x))
                (true-list-list-listp (cdr x))))))

(defun nth-list-list-aux (n items acc)
  (declare (xargs :guard (and (natp n)
                              (true-list-list-listp items)
                              (true-listp acc))))
  (if (endp items)
      (reverse acc)
    (nth-list-list-aux n (cdr items) (cons (nth-list n (car items)) acc))))

(defun nth-list-list (n items)
  (declare (xargs :guard (and (natp n)
                              (true-list-list-listp items))))
  (nth-list-list-aux n items nil))

(defun all-equal-list (item lsts)
  (declare (xargs :guard (true-list-listp lsts)))
  (if (endp lsts)
      t
    (and (all-equal$ item (car lsts))
         (all-equal-list item (cdr lsts)))))

;; (defun all-same-lst (lsts)
;;   (all-equal-list (car (car lsts)) lsts))

;fixme not tail rec
(defun get-nths-from-traces-rev (count traces)
  (declare (xargs :guard (and (natp count)
                              (true-list-list-listp traces))))
  (if (zp count)
      nil
    (cons (nth-list-list (+ -1 count) traces)
          (get-nths-from-traces-rev (+ -1 count) traces))))

;use this more?
(defun get-nths-from-traces (arg-count args-traces)
  (declare (xargs :guard (and (natp arg-count)
                              (true-list-list-listp args-traces))))
  (reverse (get-nths-from-traces-rev arg-count args-traces)))

(defun get-nths-from-values-rev (count values)
  (declare (xargs :guard (and (natp count)
                              (true-list-listp values))))
  (if (zp count)
      nil
    (cons (nth-list (+ -1 count) values)
          (get-nths-from-values-rev (+ -1 count) values))))

(defun get-nths-from-values (count values)
  (declare (xargs :guard (and (natp count)
                              (true-list-listp values))))
  (reverse-list (get-nths-from-values-rev count values)))



;these are things that look like lists (not requiring true-listp though)
(defun nil-or-consp (x)
  (declare (xargs :guard t))
  (or (eq nil x)
      (consp x)))

(defun nil-or-consp-list (x)
  (declare (xargs :guard (true-listp x)))
  (if (endp x)
      t
    (and (nil-or-consp (car x))
         (nil-or-consp-list (cdr x)))))

(defun nil-or-consp-list-list (x)
  (declare (xargs :guard (true-list-listp x)))
  (if (endp x)
      t
    (and (nil-or-consp-list (car x))
         (nil-or-consp-list-list (cdr x)))))

(defun nil-or-consp-list-list-list (x)
  (declare (xargs :guard (true-list-list-listp x)))
  (if (endp x)
      t
    (and (nil-or-consp-list-list (car x))
         (nil-or-consp-list-list-list (cdr x)))))

(defun len-equal-list (list len)
  (declare (xargs :guard (true-listp list)))
  (if (endp list)
      t
    (and (equal (len (car list)) len)
         (len-equal-list (cdr list) len))))

;tests that the length of every element of every list is LEN
(defun len-equal-list-list (list-of-lists len)
  (declare (xargs :guard (true-list-listp list-of-lists)))
  (if (endp list-of-lists)
      t
    (and (len-equal-list (car list-of-lists) len)
         (len-equal-list-list (cdr list-of-lists) len))))

(defun len-equal-list-list-list (list-of-list-of-lists len)
  (declare (xargs :guard (true-list-list-listp list-of-list-of-lists)))
  (if (endp list-of-list-of-lists)
      t
    (and (len-equal-list-list (car list-of-list-of-lists) len)
         (len-equal-list-list-list (cdr list-of-list-of-lists) len))))

;careful! (all-all-natp '(0 0)) since (all-natp '0)
(defun all-all-natp (x)
  (declare (xargs :guard t))
  (if (consp x)
      (and (all-natp (car x))
           (all-all-natp (cdr x)))
      t))

(defun all-all-all-natp (x)
  (declare (xargs :guard t))
  (if (consp x)
      (and (all-all-natp (car x))
           (all-all-all-natp (cdr x)))
      t))

;fixme make tail rec?
(defun maxnat (lst)
  (declare (xargs :guard (rational-listp lst)
                  :guard-hints (("Goal" :in-theory (enable rational-listp)))
                  :verify-guards nil ;done below
                  ))
  (if (endp lst)
      0
    (if (endp (cdr lst))
        (car lst)
      (max (car lst) (maxnat (cdr lst))))))

(defthm rationalp-of-maxnat
  (implies (rational-listp lst)
           (rationalp (maxnat lst))))

(verify-guards maxnat)

(defun rational-list-listp (x)
  (declare (xargs :guard t))
  (if (atom x)
      (null x)
    (and (rational-listp (first x))
         (rational-list-listp (rest x)))))

(defun rational-list-list-listp (x)
  (declare (xargs :guard t))
  (if (atom x)
      (null x)
    (and (rational-list-listp (first x))
         (rational-list-list-listp (rest x)))))

(defun maxnat-list (x)
  (declare (xargs :guard (rational-list-listp x)))
  (if (endp x)
      0 ;fixme
    (max (maxnat (car x))
         (maxnat-list (cdr x)))))

(defthm rationalp-of-maxnat-list
  (implies (rational-list-listp lst)
           (rationalp (maxnat-list lst))))

(defun maxnat-list-list (x)
  (declare (xargs :guard (rational-list-list-listp x)))
  (if (endp x)
      0 ;fixme
    (max (maxnat-list (car x))
         (maxnat-list-list (cdr x)))))

;find a non-empty list in the trace, if one is present, otherwise nil
(defun find-a-list-element-in-trace (trace)
  (declare (xargs :guard (true-listp trace)))
  (if (endp trace)
      nil
    (let* ((val (first trace)))
      (or val
          (find-a-list-element-in-trace (rest trace))))))

;find a non-empty list in the traces, if one is present, otherwise nil
(defun find-a-list-element-in-traces (traces)
  (declare (xargs :guard (true-list-listp traces)))
  (if (endp traces)
      nil
    (let* ((trace (first traces)))
      (or (find-a-list-element-in-trace trace)
          (find-a-list-element-in-traces (rest traces))))))

(defun all-have-bit (bit-index bit-value nats)
  (declare (xargs :guard (and (natp bit-index)
                              (integer-listp nats))))
  (if (endp nats)
      t
    (and (equal bit-value (getbit bit-index (first nats)))
         (all-have-bit bit-index bit-value (rest nats)))))

;returns (mv num-bits constant-value) where if num-bits is 0, no pattern was found
(defun find-constant-low-bits-aux (nats highest-index-to-check bit-index constant-value)
  (declare (xargs :guard (and (integer-listp nats)
                              (consp nats)
                              (integerp constant-value))
                  :measure (nfix (+ 1 (- highest-index-to-check bit-index)))
                  :hints (("Goal" :in-theory (enable natp)))
                  ))
  (if (or (not (natp highest-index-to-check))
          (not (natp bit-index))
          (< highest-index-to-check bit-index))
      (mv bit-index constant-value)
    (let* ((first-nat (first nats))
           (this-bit-of-first-nat (getbit bit-index first-nat)))
      (if (all-have-bit bit-index this-bit-of-first-nat (rest nats))
          (find-constant-low-bits-aux nats highest-index-to-check (+ 1 bit-index) (bvcat 1 this-bit-of-first-nat bit-index constant-value))
        (mv bit-index constant-value)))))

;looks for a segment of low bits that are the same in each element of nats (looking at high bits might be tricky, since random testing will never generate, say, sequences whose lengths have 1s in their high bits)
;returns (mv num-bits constant-value) where if num-bits is 0, no pattern was found
;nats must be non-empty
;example: (find-constant-low-bits '(62 126 190 254 318)) = (mv 6 62) meaning every value has 62 as it low 6 bits
(defun find-constant-low-bits (nats)
  (declare (xargs :guard (and (integer-listp nats)
                              (consp nats))))
  (find-constant-low-bits-aux nats 32 0 0)) ;fixme pass in a size instead of hard-coding 32 here

(defun all-all-have-bit (bit-index bit-value list-of-lists)
  (declare (xargs :guard (and (natp bit-index)
                              (integer-list-listp list-of-lists))))
  (if (endp list-of-lists)
      t
    (and (all-have-bit bit-index bit-value (first list-of-lists))
         (all-all-have-bit bit-index bit-value (rest list-of-lists)))))

;returns (mv num-bits constant-value) where if num-bits is 0, no pattern was found
(defun find-constant-low-bits2-aux (list-of-lists highest-index-to-check bit-index constant-value)
  (declare (xargs :guard (and (integer-list-listp list-of-lists)
                              (consp list-of-lists)
                              (all-consp list-of-lists)
                              (integerp constant-value))
                  :measure (nfix (+ 1 (- highest-index-to-check bit-index)))
                  :hints (("Goal" :in-theory (enable natp)))
                  ))
  (if (or (not (natp highest-index-to-check))
          (not (natp bit-index))
          (< highest-index-to-check bit-index))
      (mv bit-index constant-value)
    (let* ((first-list (first list-of-lists))
           (first-nat (first first-list))
           (this-bit-of-first-nat (getbit bit-index first-nat)))
      (if (all-all-have-bit bit-index this-bit-of-first-nat list-of-lists)
          (find-constant-low-bits2-aux list-of-lists highest-index-to-check (+ 1 bit-index) (bvcat 1 this-bit-of-first-nat bit-index constant-value))
        (mv bit-index constant-value)))))

;example: (find-constant-low-bits2 '((62) (126 190) (254 318))) = (mv 6 62) meaning every value has 62 as it low 6 bits
;returns (mv num-bits constant-value) where if num-bits is 0, no pattern was found
(defun find-constant-low-bits2 (list-of-lists)
  (declare (xargs :guard (and (integer-list-listp list-of-lists)
                              (consp list-of-lists)
                              (all-consp list-of-lists))))
  (find-constant-low-bits2-aux list-of-lists 32 0 0)) ;fixme pass in a size instead of hard-coding 32 here

;; (defun contiguousp-list (lists)
;;   (declare (xargs :guard (and (true-list-listp lists)
;;                               (ALL-all-integerp lists))))
;;   (if (endp lists)
;;       t
;;     (and (contiguousp (car lists))
;;          (contiguousp-list (cdr lists)))))

;each item is a list (items may be a single trace)
(defun all-same-lengthp (items)
  (declare (xargs :guard (true-list-listp items)))
  (if (endp items)
      t
    (let ((len (length (first items))))
      (items-have-len len items))))

;each item is a list of lists (a trace)
(defun all-all-same-lengthp (items)
  (declare (xargs :guard (true-list-list-listp items)))
  (if (endp items)
      t
    (and (all-same-lengthp (first items))
         (all-all-same-lengthp (rest items)))))

;some of the traces might be empty - this finds the first value in the first-non-empty trace
;fixme or should we remove empty traces before pattern finding?
;deprecate?
(defun find-a-val-in-traces (traces)
  (declare (xargs :guard (true-list-listp traces)))
  (if (endp traces)
      (hard-error 'find-a-val-in-traces "All traces are empty!" nil)
    (let* ((trace (first traces)))
      (if (endp trace) ;this trace is empty, so skip it:
          (prog2$ (hard-error 'find-a-val-in-traces "this should not happen" nil)
                  (find-a-val-in-traces (rest traces)))
;found a non empty trace; return its first value:
        (first trace)))))

;use defforall?
(defun all-all-same (items)
  (declare (xargs :guard (and (true-listp items)
                              (all-true-listp items))))
  (if (endp items)
      t
    (and (all-same (car items))
         (all-all-same (cdr items)))))

;fixme what if some traces are empty?
;seeks terms for which the traces are of the form (lengths can differ):
;((k1 k1 k1 k1 k1 k1 k1 .. k1)
; (k2 k2 k2 k2 k2 .. k2)
; ..
; (kn kn kn kn kn kn kn kn kn kn .. kn))
;where the k's are integers
;pairs the term with (k1 k2 .. kn) in the result alist
;drops all other terms from the result alist
;destructs the terms as trees
;returns an alist
;fffixme pass in a term to ignore (the term we are trying to bound)?

;this now dives down until it hits scalars (it was either that or change find-term-with-constant-difference to dive into its arguments)
(skip-proofs
 (mutual-recursion
  ;;returns an alist
  ;;rename this?
  (defun pair-terms-with-constants (term traces)
    (let ((value (first (first traces)))) ;fffixme what if the first trace happens to start with nil?? maybe the traces can't be empty..
      (if (nil-or-consp-list-list traces) ;(consp value)
          ;;TERM represents a list:
          (append
           ;;this is newish:
           (pair-terms-with-constants `(len ,term)
                                      ;;inefficient?
                                      (len-list-list traces))
           (and (len-equal-list-list traces (len value)) ;; makes sure they all have the same length:
                (pair-terms-with-constants-list (make-nth-terms-rev (len value) term)
                                                (get-nths-from-traces-rev (len value) traces))))
        ;;TERM represents a scalar (check for integerp?):
        (if (all-all-same traces) ;tests whether each trace is a repeated value
            (let ((vals-for-each-trace (strip-cars traces)))
              (and (ALL-INTEGERP vals-for-each-trace)
                   (acons-fast term vals-for-each-trace nil)))
          nil))))

  ;;returns an alist
  ;;term-lst and traces-lst are in sync
  (defun pair-terms-with-constants-list (term-lst traces-lst)
    (if (endp term-lst)
        nil
      (append (pair-terms-with-constants (first term-lst) (first traces-lst))
              (pair-terms-with-constants-list (rest term-lst) (rest traces-lst)))))))

(skip-proofs (verify-guards pair-terms-with-constants-list))

(DEFUN MAP-LAST-ELEM (X)
  (declare (xargs :guard (all-consp x)))
  (IF (ATOM X)
      NIL
    (CONS (LAST-ELEM (CAR X))
          (MAP-LAST-ELEM (CDR X)))))

;seq1 and seq2 should be the same length and not nil
(defun corresponding-elements-have-difference (diff seq1 seq2)
  (declare (xargs :guard (and (integerp diff)
                              (integer-listp seq1)
                              (integer-listp seq2)
                              (equal (len seq1) (len seq2)))
                  :guard-hints (("Goal" :in-theory (enable integer-listp)))))
  (if (endp seq1)
      t
    (and (eql diff (- (car seq1) (car seq2)))
         (corresponding-elements-have-difference diff (cdr seq1) (cdr seq2)))))

;;returns (mv term-or-nil difference) where if TERM-OR-NIL is non-nil, we found a match and DIFFERENCE is (nth i seq)-(nth i <seq-for-term>), for all i
(defun find-term-with-constant-difference (seq term-seq-alist)
  (declare (xargs :guard (and (integer-listp seq)
                              (consp seq) ; ok?
                              (alistp term-seq-alist))))
  (if (endp term-seq-alist)
      (mv nil nil)
    (let* ((entry (car term-seq-alist))
           (seq2 (cdr entry)))
      (if (or (not (integer-listp seq2)) ;restrict to integers? ;fixme maybe term-seq-alist only contains integer sequences?
              (not (equal (len seq) (len seq2))))
          (find-term-with-constant-difference seq (cdr term-seq-alist))
        (let ((first-diff (- (car seq) (car seq2))))
          ;;do we already have a function that computes something like this?:
          (if (corresponding-elements-have-difference first-diff seq seq2)
              (mv (car entry) ;the term found
                  first-diff)
            (find-term-with-constant-difference seq (cdr term-seq-alist))))))))

;use this more?
(defun make-bvplus-term (size constant term)
  (declare (xargs :guard (eqlablep constant)))
  (if (eql 0 constant)
      term ;maybe this should have a chop?
    `(bvplus ',size ',constant ,term)))


;trying a signed comparison in this. fffixme generalize the 32 to the appropriate size...
;allows successive elements to be equal
(defun non-decreasingp (seq)
  (declare (xargs :guard (and (true-listp seq)
                              (all-integerp ;rational-listp
                               seq))))
  (if (endp seq)
      t
    (if (endp (cdr seq))
        t
      (and (sbvle 32 ;<=
            (first seq)
            (second seq))
           (non-decreasingp (rest seq))))))

;allows successive elements to be equal
(defun non-increasingp (seq)
  (declare (xargs :guard (and (true-listp seq)
                              (all-integerp ;rational-listp
                               seq))))
  (if (endp seq)
      t
    (if (endp (cdr seq))
        t
      (and (sbvle 32 ;<=
                  (second seq)
                  (first seq))
           (non-increasingp (rest seq))))))

(defforall all-rational-listp (seqs) (rational-listp seqs) :declares ((xargs :guard t)))

;(defforall all-true-listp (seqs) (true-listp seqs) :declares ((xargs :guard t)))

(defforall all-all-true-listp (seqs) (all-true-listp seqs) :declares ((xargs :guard t)))

;(defforall all-all-integerp (seqs) (all-integerp seqs) :declares ((xargs :guard t)))

;the defforall should generate this?
(defthm all-integerp-of-nth
  (implies (and (all-all-integerp x)
                (consp x) ;move to conclusion?
                )
           (all-integerp (nth 0 x)))
  :hints (("Goal" :in-theory (enable all-all-integerp))))

(defforall all-non-decreasingp (seqs) (non-decreasingp seqs) :declares ((xargs :guard (and (all-true-listp seqs)
                                                                                           (all-all-integerp ;all-rational-listp
                                                                                            seqs)))))

(defforall all-non-increasingp (seqs) (non-increasingp seqs) :declares ((xargs :guard (and (all-true-listp seqs)
                                                                                           (all-all-integerp ;all-rational-listp
                                                                                            seqs)))))

;;each trace in TRACES is the sequence of integer values for a single loop variable (component or length?), on the recursive calls of the loop function for a single test case.
;returns a list of hyps
;does whether the sequence is contiguous give us a clue what to do?
;;checks for a contiguous sequence - fixme drop this  ;(equal (bvminus 32 maxelem minelem) (+ -1 (len sequence)))
;fixme add more stuff
;fixme - try to determine whether the values are bytes, shorts, ints, or longs - can ints that only cover a small range be treated as bytes?  maybe not if we want to see sbvlt with 32 instead of sbvlt with 8??
;fixme - what if the range of a variable depends on, say, the size of the input
;we'd need to look for a pattern relating the variable to the input size, rather than just putting in a bound?
;but maybe if the number of calls in each trace is the same we can do something better, even if the data looks random?
;redo this.  first split according to all-traces-same.  then find the true min and max.  this should help with the type (also check for negative min).
(defun find-type-facts-for-integer (term traces size-already-asserted)
  ;;if all the traces are the same, we generate a tighter bound
  ;;the fear when the values depend on the test case is that we haven't seen the largest possible values
  ;; for example if they are pseudo-random 32-bit numbers, we're unlikely to see ffffffff by chance but don't want to rule it out.
  (let ((all-traces-same (all-same traces))
        (natps (all-all-natp traces))
        ) ;take more advantage of this below (e.g., when finding the min and max..)
    (append
     ;;bounds and type facts:
     (mv-let (minelem maxelem)
             ;;fixme, this currently applies only to 32-bit elements (it does a logext 32):
             ;;fixme if we know that all traces are the same, we only need to consider one trace here:
             (min-and-max-integer-list-list traces (logext 32 (car (car traces))) (logext 32 (car (car traces))))
             (prog2$
              (cw "(~x0: Min ~x1. Max ~x2.)~%" term minelem maxelem)
              (if all-traces-same
                  ;;The values don't depend on the test case, so we can be pretty aggressive:
                  ;;fixme pay attention to size-already-asserted??
                  (make-bounds-and-type-facts minelem maxelem term size-already-asserted)
                ;;the values depend on the test case, and we probably haven't seen them all:
                ;;should we round up to a power of 2?
                ;;should we look at whether the sequences are contiguous and/or monotonic? - done elsewhere?
                ;;fixme, what if there is a value larger than this that we just haven't seen yet in a test case?

                ;;check for a contiguous range of values present on any trace  - if so, use the smallest value???

                ;;if we have never seen a negative value on any trace, assert that there aren't any:
                (append (if (and natps ;Mon Mar 14 14:27:48 2011
                                 (<= 0 minelem) ;this bound may not be tight.. ;fixme use sbvlt?
                                 ;;only do it if there is no size already asserted, or we can improve on it
                                 (or (not size-already-asserted)
                                     (< 31 size-already-asserted)))
                            `((unsigned-byte-p '31 ,term) ;this is how we say non-negative, but what about 64-bit values?
                              )
                          nil)
                        (if (and natps ;Mon Mar 14 14:27:48 2011
                                 (or (not size-already-asserted)
                                     (< 32 size-already-asserted)))
                            (list `(unsigned-byte-p '32 ,term) ;what about 64-bit values? ;fixme check this!
                                  )
                          nil)) ;i hope this is safe what about longs?! (do all integers come from java locals?  what about (len msg) for a sha1 msg?)
                )))
     ;;facts about remainders:
     ;fixme examine the other traces!
     (and all-traces-same ;fixme?
          (let* ((sequence (car traces)))
            (and (< 1 (len sequence)) ;otherwise, get-diffs doesn't work right - fixme could have bad luck an get a seq of length 1 as the first one!
                 (let* ((diffs (get-diffs 'find-type-facts-for-integer sequence)) ;could stop consing this up if not all-same...
                        (diff (car diffs))
                        (diff (logext 32 diff))
                        (diff (abs diff)))
                   (and (all-same diffs)
                        (< 1 diff)
                        (list `(equal (sbvmoddown '32 ,term ',diff)
                                      ',(mod (car sequence) diff))))))))

     ;;facts about bits:
     (mv-let (num-bits constant-value)
             (find-constant-low-bits2 traces)
             (and (posp num-bits)
                  `((equal (bvchop ;$inline
                            ',num-bits ,term)
                           ',constant-value)))))))

(skip-proofs (verify-guards find-type-facts-for-integer))

;fixme combine this with the above, and make things more efficient!
;returns a list of bound hyps about TERM, which represents an integer
(defun find-bounds-for-integer (term ;i suppose this is a formal perhaps wrapped in nths and maybe a len?
                                traces
                                alist-for-terms-unchanged-per-trace ;the keys of this alist may appear in the bounds generated by this function (fixme does this exclude term?) ;;fixme should this include old vars? yes?!
                                ;;we don't need to remove term itself from alist-for-terms-unchanged-per-trace because it term itself is unchanged per trace we don't use alist-for-terms-unchanged-per-trace
                                formal-to-old-var-alist)
  (let* ((unchanged-per-trace ;(all-all-same traces)
          (assoc-equal term alist-for-terms-unchanged-per-trace) ;Fri Feb 25 22:56:11 2011
          ))
    (if unchanged-per-trace
        ;; If term is unchaned per trace, we'll generate a hyp that is equals its old var and also will have hyps about that var. (fixme does something try to explain the vals in that case?)
        nil
      (let* ( ;;fixme these computations should be done mod 32 (or whatever the appropriate size is)?!
             (increasingp (all-non-decreasingp traces))
             (decreasingp (all-non-increasingp traces)))
        (if (or increasingp decreasingp)
            (let ( ;what about i counting up and j counting down until they cross?
                  (lower-bounds (if increasingp (strip-cars traces) (map-last-elem traces)))
                  (upper-bounds (if increasingp (map-last-elem traces) (strip-cars traces))))
              (append
               ;;fixme gen the 32?! ;fixme use bvlt?
               (let ((old-term (replace-in-term2 term formal-to-old-var-alist)))
                 (if increasingp
                     `((not (sbvlt '32 ,term ,old-term)))
                   `((not (sbvlt '32 ,old-term ,term)))))

               ;; lower bound:
               (if (all-same lower-bounds) ;;use all-eql$? ;slow to cons this up? ;fixme handle different starting values.. ;fixme what about empty traces?
                   `((not (sbvlt '32 ,term ',(first lower-bounds)))) ;ffixme i hope the 32's throughout this function are okay

                 ;; the traces count up from different values, so try to find an expression for the starting values
                 (mv-let (term-or-nil difference)
                         (find-term-with-constant-difference lower-bounds alist-for-terms-unchanged-per-trace) ;order of args?
                         (if term-or-nil
                             ;; term <= term-or-nil + difference ;fixme what about term minus difference?!
                             `((not (sbvlt '32 ,term ,(make-bvplus-term '32 difference term-or-nil))))
                           ;;could not find a lower bound:
                           nil)))

               ;;upper bound:
               (if (all-same upper-bounds)
                   ;; all traces count up to the same value:
                   `((not (sbvlt '32 ',(first upper-bounds) ,term)))

                 ;; the traces count up to different values, so try to find an expression for the ending values
                 (mv-let (term-or-nil difference)
                         (find-term-with-constant-difference upper-bounds alist-for-terms-unchanged-per-trace) ;order of args?
                         (if term-or-nil
                             ;; term <= term-or-nil + difference
                             `((not (sbvlt '32 ,(make-bvplus-term '32 difference term-or-nil) ,term)))
                           ;;could not find an upper bound:
                           nil)))))
          ;;handle a variable amount counting up to a constant? are there 4 cases? 6? huh?
          ;;handle the case where one var counts up to another var (we do if that other var is unchanged)
          ;;e.g., (for int i = 0; i <= k; i++) {body-that-doesnt-change-k}  <- isn't that what this handles?
          nil)))))

(skip-proofs (verify-guards find-bounds-for-integer))

;fixme handle improper lists somehow?
;fixme - think this through
;is this inefficient?
;the traces must be non-empty (if the loop just returns, the trace has one element)
  ;;as usual, each trace is the sequence of values corresponding to TERM on a single test case
(skip-proofs
 (mutual-recursion
  ;;tries to find hyps for TERM, based on TRACES (a list of traces for TERM)
  ;;fixme this assumes all of the values have the same shape (what about the lengths of lists?)
  ;;returns a list of hyps, or nil
  (defun try-to-find-invars-for-term (term traces size-asserted formal-to-old-var-alist alist-for-terms-unchanged-per-trace)
    (declare (xargs :measure 1))
    (let* ((trace (car traces))
           (value (car trace)) ;(value (find-a-val-in-traces traces)) ;Fri Feb 25 19:46:43 2011
           )
      ;; If every trace is just a repetition of value (wouldn't such a component of the params be dropped?): does the explanation stuff find this?
      (if (all-equal-list value traces)
          `((equal ,term ',value))
        (if (nil-or-consp-list-list traces)
            ;;the values in the traces are lists (and are not all nil):
            ;;fixme - if the parameter is just passed from one call to the next, try to get its type by looking at the term passed in to the outer call?
            (let* ((len (len value)) ;;Generate a hyp about the list length:
                   (all-same-lengthp (len-equal-list-list traces len))

                   (len-hyps (if all-same-lengthp ;can we weaken this?
                                 `((equal (len ,term) ',len))
                               (append `((unsigned-byte-p '31 (len ,term))) ;this bound is satisfied by any sequence that fits in a java array
                                       (and (all-all-same-lengthp traces) ;fixme do this first and use it to quickly compute all-same-lengthp by comparing the first elems
                                            ;;the length is unchanged per trace:
                                            `((equal (len ,term) (len ,(replace-in-term2 term formal-to-old-var-alist))))))))
                   ;; Generate hyps about the list elements (fixme how to tell between a sequence and a tuple?)
                   (elems-are-natsp (all-all-all-natp traces))
                   (bv-size (and elems-are-natsp (integer-length (maxnat-list-list traces))))
                   ;;ffixme - what if the length depends on a parameter? then it's not a "type" fact, i guess
                   (size-hyps (if elems-are-natsp
                                  ;;when do i want this?:
                                  `((all-unsigned-byte-p ',bv-size ,term))
                                nil))
                   ;; handle list elements that are themselves lists (yikes) handle this better?:
                   (elems-are-listsp (nil-or-consp-list-list-list traces)) ;don't bother to check nil-or-consp; just check consp?
                   (non-empty-list-val (and elems-are-listsp (find-a-list-element-in-traces traces)))
                   (possible-elem-len (and elems-are-listsp (len (first non-empty-list-val))))
                   (all-elems-same-lengthp (and elems-are-listsp (len-equal-list-list-list traces possible-elem-len)))
                   (items-have-len-hyps (and all-elems-same-lengthp `((items-have-len ',possible-elem-len ,term))))
                   )
              (append len-hyps
                      size-hyps
                      items-have-len-hyps
                      (and (all-all-true-listp traces) `((true-listp ,term)))
                      ;;if the target always has the same length, explore the pieces:
                      ;;or should we not do this if we can't say anything more specific about the individual elements?  well, now we pass in size-asserted
                      ;;we don't do it if lists on different traces have different lengths
;fixme for the type, we could first get the type of each components and then make all-<thattype>
                      (if all-same-lengthp
                          (and (or (< len 32) ;prevents diving into big arrays ;Sun Feb 20 19:48:56 2011 ;fixme do something better
                                   (not (integer-listp value)) ;Fri Aug 20 00:52:37 2010 new, since one loop has 43 params
                                   )
                               (try-to-find-invars-for-term-lst (make-nth-terms-rev len term)
                                                                (get-nths-from-traces-rev len traces)
                                                                bv-size formal-to-old-var-alist
                                                                alist-for-terms-unchanged-per-trace
                                                                ))

                            ;;try to bound the length (e.g., if the length counts up to some other var..)
                            ;;fixme, here we could try to find a hyp about a slice of the length being constant -- how to avoid overfitting (high slice 0 because we only have small test cases)?  require that there be some non-zero bits above the slice? --could peek at the context and assumptions for the rec fn node we are generating facts for... -- or could look at ifs in the dag
                            (find-bounds-for-integer `(len ,term)
                                                     (len-list-list traces)
                                                     alist-for-terms-unchanged-per-trace
                                                     formal-to-old-var-alist))))
          ;;otherwise the elements of the traces are scalars:
          (and (all-all-integerp traces) ;what about when this is not true? will that ever happen?
               (append (find-bounds-for-integer term traces
                                                alist-for-terms-unchanged-per-trace
                                                formal-to-old-var-alist)
                       (find-type-facts-for-integer term traces size-asserted)))))))

  ;;tries to find hyps for the terms in TERM-LST, each of which has an entry in TRACES-LST
  ;;returns a list of hyps
  ;;if size-asserted is non-nil, it's an integer representing the maxsize of any bv in the list we are now processing
  (defun try-to-find-invars-for-term-lst (term-lst traces-lst size-asserted formal-to-old-var-alist alist-for-terms-unchanged-per-trace)
    (if (endp traces-lst)
        nil
      (append (try-to-find-invars-for-term (first term-lst) (first traces-lst) size-asserted formal-to-old-var-alist alist-for-terms-unchanged-per-trace)
              (try-to-find-invars-for-term-lst (rest term-lst) (rest traces-lst) size-asserted formal-to-old-var-alist alist-for-terms-unchanged-per-trace))))))

(skip-proofs (verify-guards try-to-find-invars-for-term))

; we could rename this to be more generic term already has the old vars put in
(skip-proofs
 (mutual-recursion
  ;;tries to find hyps for TERM, based on the values in VALUES
  ;;fixme does this assume all of the values have the same shape (what about the lengths of lists?)?
  ;;returns a list of hyps (possibly nil)
;could use this for any unchanged value (but for an unchanged value we'll assert x-oldx and then this will handle oldx)
  (defun try-to-find-type-facts-about-old-vals (values term size-asserted)
    (declare (xargs :measure 1))
    (let* ((value (first values)))
      (if (all-equal$ value values)
          `((equal ,term ',value))
        (if (nil-or-consp-list values)
            ;;the values are lists:
            ;;fixme - if the parameter is just passed from one call to the next, get its type by looking at the term passed in to the outer call?
            (let* ( ;;Generate a hyp about the list length:
                   (all-same-lengthp (len-equal-list values (len value)))
                   (len-hyps (if all-same-lengthp ;can we weaken this?
                                 `((equal (len ,term) ',(len value)))
                               `((unsigned-byte-p '31 (len ,term))) ;new! this bound is satisfied by any sequence that fits in a java array
                               ))
                   ;; Generate hyps about the list elements (fixme how to tell between a sequence and a tuple?)
                   (elems-are-natsp (all-all-natp values))
                   (bv-size (and elems-are-natsp (integer-length (maxnat-list values))))
                   ;;ffixme - what if the length depends on a parameter? then it's not a "type" fact, i guess
                   (all-unsigned-byte-p-hyps (and elems-are-natsp `((all-unsigned-byte-p ',bv-size ,term))))
                   ;; handle list elements that are themselves lists:
                   (elems-are-listsp (nil-or-consp-list-list values)) ;don't bother to check nil-or-consp; just check consp?
                   (list-val (first value))
;                   (non-empty-list-val (and elems-are-listsp (find-a-list-element-in-traces traces)))
                   (possible-elem-len (and elems-are-listsp (len list-val)))
                   (all-elems-same-lengthp (and elems-are-listsp (len-equal-list-list values possible-elem-len)))
                   (items-have-len-hyps (and all-elems-same-lengthp `((items-have-len ',possible-elem-len ,term))))
                   )
              (append len-hyps
                      all-unsigned-byte-p-hyps
                      items-have-len-hyps
                      (and (all-true-listp values) `((true-listp ,term)))
                      ;;hyps for the individual elements:
                      ;;or should we not do this if we can't say anything more specific about the individual elements?
                      ;;we don't do it if different values have different lengths
                      (if (and all-same-lengthp
                               (or (< (len value) 32)
                                   (not (integer-listp value))) ;Fri Aug 20 00:52:37 2010 new, since one loop has 43 params
                               )
                          (try-to-find-type-facts-about-old-vals-lst (get-nths-from-values-rev (len value) values)
                                                                     (make-nth-terms-rev (len value) term)
                                                                     bv-size)
                        nil)))
          ;;otherwise the values are scalars:
          (if (all-natp values)
;the usual case:
              (let ((max-width (width-of-widest-int values)))
                (append (if (and size-asserted (<= size-asserted 32)) nil (and (<= max-width 32) `((unsigned-byte-p '32 ,term)))) ;fixme do better?
                        (if (and size-asserted (<= size-asserted 31)) nil (and (<= max-width 31) `((unsigned-byte-p '31 ,term))))
                        ;;(find-type-facts-for-integer term values 32) ;ffixme make a version of this that takes a set of values, not a set of traces..
                        (mv-let (num-bits constant-value)
                                (find-constant-low-bits values) ;fixme could do this in the all-integerp case below too
                                (and (posp num-bits)
                                     `((equal (bvchop ;$inline
                                               ',num-bits ,term)
                                              ',constant-value))))))
            ;;not all natps (I saw this with a reps param that was sometimes -1)
            (if (all-integerp values)
                `((integerp ,term))
              nil))))))

  ;;tries to find hyps for the terms in TERM-LST, each of which has an element of VALUES-LST
  ;;old: if size-asserted is non-nil, its an integer representing the maxsize of any bv in the list we are now processing
  (defun try-to-find-type-facts-about-old-vals-lst (values-lst term-lst size-asserted)
    (if (endp values-lst)
        nil
      (append (try-to-find-type-facts-about-old-vals (car values-lst) (car term-lst) size-asserted)
              (try-to-find-type-facts-about-old-vals-lst (cdr values-lst) (cdr term-lst) size-asserted))))))

(skip-proofs (verify-guards try-to-find-type-facts-about-old-vals))

;;returns the sequence n_i such that target_i = (nth n_i value_i), or nil if there is no such sequence
(defun make-nth-list-for-nthcdr-aux (target-seq value-seq acc)
  (declare (xargs :guard (and (true-listp target-seq)
                              (true-list-listp value-seq)
                              (true-listp acc))))
  (if (endp target-seq)
      (reverse acc)
    (let* ((target (car target-seq))
           (value (car value-seq))
           (target-len (len target))
           (value-len (len value))
           (len-diff (- value-len target-len)))
      (if (and (natp len-diff)
               (equal target (nthcdr len-diff value)))
          (make-nth-list-for-nthcdr-aux (cdr target-seq) (cdr value-seq) (cons len-diff acc))
        nil))))

(defun make-nth-list-for-nthcdr (target-seq value-seq)
  (declare (xargs :guard (and (true-listp target-seq)
                              (true-list-listp value-seq))))
  (make-nth-list-for-nthcdr-aux target-seq value-seq nil))

;returns nth-seqs, or nil for failure
(defun make-nth-list-for-nthcdr-list-aux (target-seqs value-seqs nth-seqs-acc)
  (declare (xargs :guard (and (true-list-list-listp target-seqs)
                              (true-list-list-listp value-seqs)
                              (true-listp nth-seqs-acc))))
  (if (endp target-seqs)
      (reverse nth-seqs-acc)
    (let ((res (make-nth-list-for-nthcdr (car target-seqs) (car value-seqs))))
      (if (not res)
          nil
        (make-nth-list-for-nthcdr-list-aux (cdr target-seqs) (cdr value-seqs) (cons res nth-seqs-acc))))))

;returns nth-seqs or nil to indicate failure
(defun make-nth-list-for-nthcdr-list (target-seqs value-seqs)
  (declare (xargs :guard (and (true-list-list-listp target-seqs)
                              (true-list-list-listp value-seqs))))
  (make-nth-list-for-nthcdr-list-aux target-seqs value-seqs nil))

;;returns the sequence n_i such that target_i = (firstn n_i value_i), or nil if there is no such sequence
(defun make-nth-list-for-firstn-aux (target-seq value-seq acc)
  (if (endp target-seq)
      (reverse acc)
    (let* ((target (car target-seq))
           (value (car value-seq))
           (target-len (len target)))
      (if (equal (firstn target-len value) target)
          (make-nth-list-for-firstn-aux (cdr target-seq) (cdr value-seq) (cons target-len acc))
        nil))))

(defun make-nth-list-for-firstn (target-seq value-seq)
  (make-nth-list-for-firstn-aux target-seq value-seq nil))

;returns nth-seqs, or nil for failure
(defun make-nth-list-for-firstn-list-aux (target-seqs value-seqs nth-seqs-acc)
  (if (endp target-seqs)
      (reverse nth-seqs-acc)
    (let ((res (make-nth-list-for-firstn (car target-seqs) (car value-seqs))))
      (if (not res)
          nil
        (make-nth-list-for-firstn-list-aux (cdr target-seqs) (cdr value-seqs) (cons res nth-seqs-acc))))))

;returns nth-seqs or nil to indicate failure
(defun make-nth-list-for-firstn-list (target-seqs value-seqs)
  (make-nth-list-for-firstn-list-aux target-seqs value-seqs nil))

(defun cdr-of-alist-values (alist)
  (declare (xargs :guard (and (alistp alist)
                              (all-consp (strip-cdrs alist)))))
  (if (endp alist)
      nil
    (let* ((pair (car alist))
           (key (car pair))
           (value (cdr pair))
           (value (cdr value))
           (pair (cons key value)))
      (cons pair (cdr-of-alist-values (cdr alist))))))

(defun car-of-alist-values (alist)
  (declare (xargs :guard (and (alistp alist)
                              (all-consp (strip-cdrs alist)))))
  (if (endp alist)
      nil
    (let* ((pair (car alist))
           (key (car pair))
           (value (cdr pair))
           (value (car value))
           (pair (cons key value)))
      (cons pair (car-of-alist-values (cdr alist))))))

;; (defun enquote-of-alist-values (alist)
;;   (if (endp alist)
;;       nil
;;     (let* ((pair (car alist))
;;            (key (car pair))
;;            (value (cdr pair))
;;            (value (enquote value))
;;            (pair (cons key value)))
;;       (cons pair (enquote-of-alist-values (cdr alist))))))

(mutual-recursion
;the cars of alist can be big terms (not just symbols)
;the cdrs of alist are non quoted
;returns the value of FORM when the cars are ALIST are replaced with their corresponding cdrs
;the cars of alist should be disjoint (e.g., (nth '0 x) and (nth '1 x))
;ffixme compare to SUBLIS-VAR-AND-EVAL - not the same, i guess
  (defun subst-and-eval (alist form interpreted-function-alist)
    (declare (xargs :guard (and (alistp alist)
                                (pseudo-termp form)
                                (interpreted-function-alistp interpreted-function-alist))))
    (cond ((quotep form) (unquote form))
          (t (let ((a (assoc-equal form alist)))
               (if a
                   (cdr a)
                 (cond ((variablep form)
                        (hard-error 'subst-and-eval "found a variable with no binding: ~x0 (vars with bindings ~x1)"
                                    (acons #\0 form (acons #\1 (strip-cars alist) nil))))
                       ;;special handling of IF? (BVIF?  MYIF?)  maybe not worth it
                       ;;must be a function call (fixme, what about lambdas?!)
                       (t (let ((args (subst-and-eval-lst alist (fargs form) interpreted-function-alist)))
                            (apply-axe-evaluator (ffn-symb form) args interpreted-function-alist 0)))))))))

  ;;returns a list of values
  (defun subst-and-eval-lst (alist l interpreted-function-alist)
    (declare (xargs :guard (and (alistp alist)
                                (pseudo-term-listp l)
                                (interpreted-function-alistp interpreted-function-alist))))
    (if (atom l)
        nil
      (cons (subst-and-eval alist (car l) interpreted-function-alist)
            (subst-and-eval-lst alist (cdr l) interpreted-function-alist)))))

;the cars of value-value-alist are not always vars!
(defun pattern-works-on-element (target pattern value-value-alist)
  (declare (xargs :guard (and (alistp value-value-alist)
                              (pseudo-termp pattern))))
;;   (let* ((quoted-expected-target ))
;;     (if (not (quotep quoted-expected-target))
;;         (prog2$ (print-list value-value-alist)
;;                 (hard-error
;;                  'pattern-works-on-element
;;                  "expected a quotep for pattern ~x0 on value-alist ~x1 (also printed just above this msg) but got ~x2"
;;                  (acons #\0 pattern (acons #\1 value-value-alist (acons #\2 quoted-expected-target nil)))))
;;       (let ((expected-target (unquote quoted-expected-target)))
        (equal (subst-and-eval value-value-alist
                               pattern
                               nil ;fixme
                               )
               target))
;        ))))

;walk down the target sequence, making sure it matches the pattern
;the pattern mentions symbols that are keys in value-trace-alist
;the values in value-trace-alist are single traces
;we walk down the values in the alist in sync with the target-trace
;fixme - what if things have different lengths?
(defun pattern-works-on-trace (pattern target-trace value-trace-alist)
  ;; (declare (xargs :guard (and (true-listp target-trace)
  ;;                             (pseudo-termp pattern)
  ;;                             (alistp value-trace-alist)
  ;;                             (all-consp (strip-cdrs value-trace-alist)))))
  (if (endp target-trace)
      t
    (and (pattern-works-on-element (car target-trace) pattern (car-of-alist-values value-trace-alist))
         (pattern-works-on-trace pattern (cdr target-trace) (cdr-of-alist-values value-trace-alist)))))

(skip-proofs (verify-guards PATTERN-WORKS-ON-TRACE))

;fixme could add a wrapper that trims the alist by dropping pairs whose keys aren't mentioned in the pattern
;PATTERN mentions the symbols that are keys in VALUE-TRACES-ALIST
;the values in value-traces-alist are lists of traces
;we walk down the values in the alist in sync with the target-traces
(defun pattern-works-on-traces (pattern target-traces value-traces-alist)
  (if (endp target-traces)
      t
    (and (pattern-works-on-trace pattern (car target-traces) (car-of-alist-values value-traces-alist))
         (pattern-works-on-traces pattern (cdr target-traces) (cdr-of-alist-values value-traces-alist)))))

(skip-proofs (verify-guards PATTERN-WORKS-ON-TRACES))

;fixme think about when whole-value-traces may not have symbols for the keys...
;fixme - check that place-holder-term is not bound in the alist?
(defun pattern-works-on-traces2 (pattern target-traces value-traces whole-value-traces-alist)
  (pattern-works-on-traces pattern target-traces (acons-fast 'place-holder-term value-traces whole-value-traces-alist)))

(skip-proofs (verify-guards PATTERN-WORKS-ON-TRACES2))

(defun working-patterns (patterns target-traces value-traces whole-value-traces-alist)
  (if (endp patterns)
      nil
    (if (pattern-works-on-traces2 (car patterns) target-traces value-traces whole-value-traces-alist)
        (cons (car patterns) (working-patterns (cdr patterns) target-traces value-traces whole-value-traces-alist))
      (working-patterns (cdr patterns) target-traces value-traces whole-value-traces-alist))))

(skip-proofs (verify-guards working-patterns))

;;returns the pattern, or nil
(defun choose-working-pattern-if-exactly-one (patterns target-traces value-traces whole-value-traces-alist)
  (let ((working-patterns (working-patterns patterns target-traces value-traces whole-value-traces-alist)))
    (if (eql 1 (len working-patterns))
        (car working-patterns)
      nil)))

(skip-proofs (verify-guards CHOOSE-WORKING-PATTERN-IF-EXACTLY-ONE))

(defun pos-ints (bound)
  (declare (xargs :guard t))
  (if (not (posp bound))
      nil
    (cons bound (pos-ints (+ -1 bound)))))

(defun neg-ints (count)
  (declare (xargs :guard t))
  (if (not (posp count))
      nil
    (cons (- count) (neg-ints (+ -1 count)))))

(defun add-constant (constant term)
  (declare (xargs :guard t))
  (if (equal 0 constant)
      term
    `(bvplus '32 ',constant ,term)))

(defun make-div-patterns (shift-constants vertical-shift scale-factor)
  (declare (xargs :guard (true-listp shift-constants)))
  (if (endp shift-constants)
      nil
    (cons (add-constant
           vertical-shift
           `(sbvdivdown '32
                        ,(add-constant (car shift-constants) 'place-holder-term)
                        ',scale-factor))
          (make-div-patterns (cdr shift-constants) vertical-shift scale-factor))))

;fixme think about large scale-factors and also about negative scale-factors
;fixme think more about large moduluses!
(defun possible-div-patterns (scale-factor first-value first-target)
  ;; (declare (xargs :guard (and (integerp scale-factor)
  ;;                             (integerp first-value))))
  (if (equal 0 scale-factor)
      nil
    (let* ((modulus (rem first-value scale-factor)) ;bvmod? sbvmod? using rem in case scale factor is negative..
           )
      (if (and (< modulus 257) ;ffixme arbitrary limit
               (< scale-factor 256) ;Thu Mar  4 02:39:49 2010
               )
          (let* ((max-places-to-shift-right modulus)
                 (max-places-to-shift-left (+ scale-factor -1 (- modulus)))
                 ;;shifting right means subtracting from the independent variable first
                 (right-shift-constants (neg-ints max-places-to-shift-right)) ;ffixme neg-ints was called on a huge argument
                 (left-shift-constants (pos-ints max-places-to-shift-left))
                 (all-shift-constants (cons 0 (append right-shift-constants left-shift-constants)))
                 (vertical-shift (bvminus 32
                                          first-target
                                          ;;this value should be the same for all horizontal shifts:
                                          (sbvdivdown 32
                                                      first-value
                                                      scale-factor))))
            (make-div-patterns all-shift-constants vertical-shift scale-factor))
        nil))))

(skip-proofs (verify-guards possible-div-patterns))

(defun seqs-match (s1 s2)
  (declare (xargs :guard (and (true-listp s1)
                              (true-listp s2))))
  (if (or (endp s1)
          (endp s2))
      t
    (and (equal (car s1) (car s2))
         (seqs-match (cdr s1) (cdr s2)))))

(defun sequence-repeats (candidate rest)
  (declare (xargs :guard (and (true-listp candidate)
                              (consp candidate)
                              (true-listp rest))))
  (if (or (not (mbt (consp candidate)))
          (endp rest)
          (endp candidate) ;just to prevent loops?
          )
      t
    (and (seqs-match candidate rest)
         (sequence-repeats candidate (nthcdr (len candidate) rest)))))

(defun find-repeating-sequence-aux (candidate rest)
  (declare (xargs :guard (and (true-listp candidate)
                              (consp candidate)
                              (true-listp rest))
                  :measure (ACL2-COUNT rest)))
  (if (endp rest)
      candidate
    (if (sequence-repeats candidate rest)
        candidate
      (find-repeating-sequence-aux (append candidate (list (car rest))) ;expensive?
                                   (cdr rest)))))

;finds the shortest sequence that repeats until seq runs out of values
;if there's no nice pattern it will be the whole sequence
(defun find-repeating-sequence (seq)
  (declare (xargs :guard (true-listp seq)))
  (find-repeating-sequence-aux (list (car seq)) (cdr seq)))

;returns the height of a sawtooth sequence (k for (mod i k)), or nil
;fixme gen the sawtooth stuff: allow shifts and stretches
(defun sawtooth-height (sequence)
  (declare (xargs :guard (and (true-listp sequence)
                              (all-integerp sequence))
                  :verify-guards nil ; todo: first change consecutivep to use integer-listp in the guard
                  ))
  (let ((repeating-sequence (find-repeating-sequence sequence)))
    (if (consecutivep repeating-sequence)
        (len repeating-sequence)
      nil)))

(skip-proofs (verify-guards sawtooth-height))

(mutual-recursion
 ;detects whether TARGET occurs in TREE
  (defun subtree (target tree)
    (declare (xargs :guard (pseudo-termp tree)))
   (if (atom tree)
       (equal target tree)
     (if (quotep tree)
         (equal target tree) ;is that what I want to do?
       ;;function call
       (or (equal target tree)
           (subtree-lst target (fargs tree))))))

 (defun subtree-lst (target tree-lst)
   (declare (xargs :guard (pseudo-term-listp tree-lst)))
   (if (endp tree-lst)
       nil
     (or (subtree target (car tree-lst))
         (subtree-lst target (cdr tree-lst))))))

;; ;if term is (len x) we clear the keys (len x) and x
;; (defun clearkeys-that-are-subterms (term alist)
;;   (if (endp alist)
;;       nil
;;     (let* ((entry (car alist))
;;            (key (car entry)))
;;       (if (subtree key term)
;;           (clearkeys-that-are-subterms term (cdr alist))
;;         (cons entry (clearkeys-that-are-subterms term (cdr alist)))))))

;; (skip -proofs (verify-guards clearkeys-that-are-subterms))

;returns (mv found-onep seq1 seq2)
;what about seqs of exactly 1?
(defun find-long-enough-seqs (seqs1 seqs2)
  (declare (xargs :guard (and (true-listp seqs1)
                              (true-listp seqs2))))
  (if (endp seqs1)
      (mv nil nil nil)
    (let ((seq1 (car seqs1))
          (seq2 (car seqs2)))
      (if (and (< 1 (len seq1))
               (< 1 (len seq2)) ;skip if they are of the same shape?
               )
          (mv t seq1 seq2)
        (find-long-enough-seqs (cdr seqs1) (cdr seqs2))))))

;i hope the inputs will have corresponding lengths
(defun all-prefixp (lst-of-lsts1 lst-of-lsts2)
  (declare (xargs :guard (and (true-listp lst-of-lsts1)
                              (true-listp lst-of-lsts2))))
  (if (endp lst-of-lsts1)
      t
    (and (nil-or-consp (first lst-of-lsts1))
         (nil-or-consp (first lst-of-lsts2))
         (prefixp (first lst-of-lsts1)
                  (first lst-of-lsts2))
         (all-prefixp (rest lst-of-lsts1)
                      (rest lst-of-lsts2)))))

(defun all-all-prefixp (x y)
  (declare (xargs :guard (and (true-list-listp x)
                              (true-list-listp y))))
  (if (endp x)
      t
    (and (all-prefixp (first x)
                      (first y))
         (all-all-prefixp (rest x)
                          (rest y)))))

;note that (all-all-integerp '(1 2)) = t.  not so for (all-integer-listp '(1 2)).
(defforall-simple integer-listp)
(verify-guards all-integer-listp)

;; (defthm integer-listp-of-car
;;   (implies (and (all-integer-listp x)
;;                 (consp x))
;;            (integer-listp (car x)))
;;   :hints (("Goal" :in-theory (enable all-integer-listp))))

(defun max-width-of-widest-int (lst-of-lsts)
  (declare (xargs :guard (and (true-listp lst-of-lsts)
                              (all-integer-listp lst-of-lsts))
                  :guard-hints (("Goal" :in-theory (enable ALL-INTEGERP)))))
  (if (endp lst-of-lsts)
      0
    (max (width-of-widest-int (first lst-of-lsts))
         (max-width-of-widest-int (rest lst-of-lsts)))))

;use a generic?
(defun slice-pattern-works-on-trace (high low target-trace value-trace)
  (declare (xargs :guard (and (true-listp target-trace)
                              (natp low)
                              (integerp high)
                              (<= low (+ 1 high)) ;weird?
                              (integer-listp value-trace)
                              (equal (len target-trace) (len value-trace)))))
  (if (endp target-trace)
      t
    (and (equal (first target-trace) (slice high low (first value-trace)))
         (slice-pattern-works-on-trace high low (rest target-trace) (rest value-trace)))))

(defun slice-pattern-works-on-traces (high low target-traces value-traces)
  (declare (xargs :guard (and (all-true-listp target-traces)
                              (true-listp value-traces)
                              (true-listp target-traces)
                              (natp low)
                              (integerp high)
                              (<= low (+ 1 high)) ;weird?
                              (all-integer-listp value-traces)
                              (equal (len-list target-traces) (len-list value-traces)))))
  (if (endp target-traces)
      t
    (and (slice-pattern-works-on-trace high low (first target-traces) (first value-traces))
         (slice-pattern-works-on-traces high low (rest target-traces) (rest value-traces)))))

;returns nil, or an expression for the target of the form (slice <high> <low> value-term), if there is one
(defun find-slice-pattern-aux (low max-low slice-width target-traces value-traces value-term)
  (declare (xargs :measure (nfix (+ 1 (- max-low low)))
                  :guard (and (all-true-listp target-traces)
                              (true-listp value-traces)
                              (true-listp target-traces)
                              (all-integer-listp value-traces)
                              (equal (len-list target-traces) (len-list value-traces))
                              (natp slice-width)
                              )
                  :hints (("Goal" :in-theory (enable natp)))
                  ))
  (if (or (not (natp low))
          (not (natp max-low))
          (< max-low low))
      nil
    (let* ((high (+ -1 low slice-width)))
      (if (slice-pattern-works-on-traces high low target-traces value-traces)
          ;fixme consider going to bvchop if low is 0?
          `(slice ',high ',low ,value-term)
        (find-slice-pattern-aux (+ 1 low) max-low slice-width target-traces value-traces value-term)))))

;;(find-slice-pattern '((3 8 0 1 4 2 5 13 10) nil (9)) '((30 197 1 15 162 19 44 105 209) nil (200)) 'value-term) = (slice '6 '3 value-term)

;returns nil, or an expression for the target of the form (slice <high> <low> value-term), if there is one
(defun find-slice-pattern (target-traces value-traces value-term)
  (declare (xargs :guard (and (all-true-listp target-traces)
                              (true-listp value-traces)
                              (true-listp target-traces)
                              (all-integer-listp target-traces)
                              (all-integer-listp value-traces)
                              (equal (len-list target-traces) (len-list value-traces)))))
  ;; begins by finding the widest target.  that's the size of the slice we are going to look for.  any narrower slice won't work
  ;; and if any wider slice would work, so would the slice that is exactly the width of the widest target (assuming we have enough test cases to have seen the true widest target)
  ;; for example, if the test cases support x = (slice 6 2 y) and x is only ever 4 bits, then they will also support x = (slice 5 2 y)
  ;; so we only try the latter
  (let* ((width-of-widest-target (max-width-of-widest-int target-traces)) ;are these things found elsewhere too?
         (width-of-widest-value (max-width-of-widest-int value-traces)))
    (find-slice-pattern-aux 0 ;try slices starting from 0
                            (+ 1 (- width-of-widest-value width-of-widest-target)) ;the maximum value of low to try
                            width-of-widest-target
                            target-traces
                            value-traces
                            value-term)))

(DEFUN MAP-NTH (N X)
  (declare (xargs :guard (and (natp n)
                              (true-list-listp x))))
  (IF (ATOM X)
      NIL
    (CONS (NTH N (CAR X))
          (MAP-NTH N (CDR X)))))

;fixme map-nth vs nth-list.
;fixme compare to get-nths-from-values
(defun get-nths-from-value-for-each-trace-rev (count candidate-value-for-each-trace)
  (declare (xargs :guard (and (natp count)
                              (true-list-listp candidate-value-for-each-trace))))
  (if (zp count)
      nil
    (cons (map-nth (+ -1 count) candidate-value-for-each-trace)
          (get-nths-from-value-for-each-trace-rev (+ -1 count) candidate-value-for-each-trace))))

(defun get-nths-from-value-for-each-trace (len candidate-value-for-each-trace)
  (declare (xargs :guard (and (natp len)
                              (true-list-listp candidate-value-for-each-trace))))
  (reverse (get-nths-from-value-for-each-trace-rev len candidate-value-for-each-trace)))

(defun all-sums-are (sum lst1 lst2)
  (declare (xargs :guard (and (true-listp lst1)
                              (true-listp lst2))))
  (if (endp lst1)
      t
    (and (eql sum (bvplus 32 (first lst1) (first lst2)))
         (all-sums-are sum (rest lst1) (rest lst2)))))

(defun all-sums-same (lst1 lst2)
  (declare (xargs :guard (and (true-listp lst1)
                              (true-listp lst2))))
  (if (endp lst1)
      t ;fixme may never happen?
    (let* ((first-sum (bvplus 32 (first lst1) (first lst2))))
      (all-sums-are first-sum (rest lst1) (rest lst2)))))

(defun reverse-alist (alist)
  (declare (xargs :guard (alistp alist)))
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry))
           (val (cdr entry)))
      (acons-fast val key (reverse-alist (cdr alist))))))

;fixme for calls to all-same below this point, what if the sequence has only 1 value?

(defun pair-terms-with-first-values-for-each-trace (candidate-traces-alist alist-acc)
  (if (endp candidate-traces-alist)
      (reverse-list alist-acc) ;drop the reverse-list?
    (let* ((entry (car candidate-traces-alist))
           (term (car entry))
           (traces (cdr entry))
           (first-vals (strip-cars traces)))
      (pair-terms-with-first-values-for-each-trace (cdr candidate-traces-alist)
                                                   (acons-fast term first-vals alist-acc)))))

(skip-proofs (verify-guards pair-terms-with-first-values-for-each-trace))

;;ffffixme add more to this?!  copy from find-basic-pattern?
;; ;fixme implement differences!  which do we subtract from which?
;fixme handle lengths?
(defun find-basic-unchanged-pattern ( ;target-term
                                     target-value-for-each-trace candidate-term candidate-value-for-each-trace)
  (if (equal target-value-for-each-trace candidate-value-for-each-trace)
      candidate-term
    (and (all-integerp target-value-for-each-trace)
         (all-integerp candidate-value-for-each-trace)
         (let ((possible-sum (bvplus 32 (first target-value-for-each-trace)
                                     (first candidate-value-for-each-trace))))
           (if (all-sums-are possible-sum target-value-for-each-trace candidate-value-for-each-trace)
               ;;TARGET+CANDIDATE=<constant>
               (if (eql 0 possible-sum)
                   `(bvuminus '32 ,candidate-term)
                 `(bvplus '32 ',possible-sum (bvuminus '32 ,candidate-term))) ;fixme generalize the 32?
             nil)))))

(skip-proofs (verify-guards find-basic-unchanged-pattern))

(defun strip-nths-and-lens (term)
  (declare (xargs :guard (pseudo-termp term)))
  (if (call-of 'nth term)
      (strip-nths-and-lens (second (fargs term)))
    (if (call-of 'len term)
        (strip-nths-and-lens (first (fargs term)))
      term)))

;determines whether we can get the target by stripping of nths
;term should be an nth nest.
(defun term-or-parent-is (term target-term)
  (declare (xargs :guard (pseudo-termp term)))
  (or (equal term target-term)
      (and (consp term)
           (call-of 'nth term)
           (term-or-parent-is (farg2 term) target-term))))

(defun term-or-a-parent-is-in (component-term terms)
  (declare (xargs :guard (and (pseudo-termp component-term)
                              (pseudo-term-listp terms))))
  (if (endp terms)
      nil
    (or (term-or-parent-is component-term (first terms))
        (term-or-a-parent-is-in component-term (rest terms)))))

(defun nth-nest-around-symbolp (term)
  (declare (xargs :guard (pseudo-termp term)))
  (or (atom term)
      (and (eq 'nth (ffn-symb term))
           (quotep (first (fargs term)))
           (nth-nest-around-symbolp (second (fargs term))))))

;; ;move to be close to where we add to the ignore alist
;; (defun okay-to-use-candidate-to-explain-target (candidate-term target-term terms-to-ignore-alist)
;;   (not (member-equal candidate-term (lookup-equal target-term terms-to-ignore-alist))))

;; (skip -proofs (verify-guards okay-to-use-candidate-to-explain-target))

;; (defun okay-to-use-candidate-to-explain-target2 (candidate-term terms-to-ignore)
;;   (not (member-equal candidate-term terms-to-ignore)))

;; (skip -proofs (verify-guards okay-to-use-candidate-to-explain-target2))

;these functions explore the tree represented by the candidate.  the target is fixed.
(skip-proofs
 (mutual-recursion

  ;;the target is unchanged *within each trace* (so for we only pass in the first value of each trace).  but the target is not constant between traces.
  ;;the candidate may or may not be unchanged within each trace (unchanged-components tells us).  if it is, we use the non-old candidate expression.
  ;; otherwise, if instructed, we use the old version of the candidate expression.  either way, we only need the first value of the candidate on each trace
  ;; note that even if the candidate is not unchanged within each trace, some of its components might be
  ;;ffffixme give up if the candidate vals are the same on every trace?
  ;;returns a term or nil (meaning no explanation)
  (defun try-to-express-whole-unchanged-non-constant-target-with-candidate (target-term
                                                                            target-value-for-each-trace
                                                                            candidate-term ;a nest of nths around a formal?  what about lens?
                                                                            candidate-value-for-each-trace
                                                                            terms-to-ignore
                                                                            consider-old-componentsp
                                                                            unchanged-components
                                                                            formal-to-old-var-alist)
    (declare (xargs :measure (acl2-count target-term))) ;;fixme bogus
    (if (not (nth-nest-around-symbolp candidate-term)) ;fixme eventually remove this
        (hard-error 'try-to-express-whole-unchanged-non-constant-target-with-candidate "not an nth nest: ~x0." (acons #\0 candidate-term nil))
      (prog2$
       nil ;(cw "Trying to express unchanged target ~x0 with candidate ~x1~%" target-term candidate-term)
       (if (member-equal candidate-term terms-to-ignore)
           (prog2$ (cw "(Explaining ~x0 with ~x1 is disallowed to prevent loops.)~%" target-term candidate-term)
                   nil)
         (let* ((candidate-is-unchangedp (term-or-a-parent-is-in candidate-term unchanged-components)) ;if x is unchanged so is (nth '4 x), for example
                (try-itp (or candidate-is-unchangedp
                             consider-old-componentsp))
                (candidate-term-to-try (if candidate-is-unchangedp candidate-term (replace-in-term2 candidate-term formal-to-old-var-alist))))

           (and try-itp
                ;; (cw "Target values: ~x0~%" target-value-for-each-trace)
                ;; (cw "Candidate values: ~x0~%" candidate-value-for-each-trace)
                ;;first try to use the whole candidate:
                (let* ( ;;(cleared-whole-candidate-traces-alist (alist::clearkey candidate-term whole-candidate-traces-alist))
                       (possible-pattern (find-basic-unchanged-pattern ;target-term
                                          target-value-for-each-trace candidate-term-to-try candidate-value-for-each-trace
                                          ;;cleared- ;why did i remove this clearing?
                                          ;;whole-candidate-traces-alist
                                          )))
                  (or possible-pattern
                      ;;now consider the pieces of candidate:
                      ;;fixme this could consider the individual bits of integer candidates?!
                      (and (nil-or-consp-list candidate-value-for-each-trace) ;if the candidates are not lists, fail

                           ;;if the candidates are lists, make the list of their lengths and look for a pattern: (fixme don't do this when dropping params?)
                           ;;fixme should find-basic-unchanged-pattern do this? not sure..
                           ;;ffixme check if all the lens are the same - if so, consider the pieces (the lengths probably won't help explain the target).  if not, try to use the lengths to explain the target
                           (let*
                               ((len-term `(len ,candidate-term-to-try))
                                (candidate-length-for-each-trace (len-list candidate-value-for-each-trace)) ;expensive to build this?
                                ;;try to explain the target using the lengths of the candidates:
                                (possible-pattern (and (not (member-equal len-term terms-to-ignore))
                                                       (find-basic-unchanged-pattern ;target-term
                                                        target-value-for-each-trace len-term ;fixme what if the candidate is not unchanged but the length is?!
                                                        candidate-length-for-each-trace
                                                        ;;cleared-
                                                        ;;whole-candidate-traces-alist
                                                        ))))
                             (or possible-pattern
                                 (and (all-same-eql candidate-length-for-each-trace) ;if the candidates are not all of the same length, don't consider the pieces
                                      ;;no pattern from the length, so consider the pieces in turn:
                                      (let* ((len (first candidate-length-for-each-trace)))
                                        ;;fixme can we drop this??
                                        (and (< 0 len) ;disallow all nils (might loop?)
                                             (or (< len 32) ;ffixme..
                                                 (not (integer-listp (first candidate-value-for-each-trace))) ;fixme look at values past the first?
                                                 )
                                             ;;would like to avoid the consing here:
                                             (let* ((candidate-component-value-for-each-trace-lst (get-nths-from-value-for-each-trace len candidate-value-for-each-trace))
                                                    (candidate-term-lst (make-nth-terms len candidate-term))
                                                    (candidate-component-value-for-each-trace-alist (pairlis$ candidate-term-lst candidate-component-value-for-each-trace-lst)))
                                               ;;we can call this version because we still know that the targets aren't all the same constant:
                                               (try-to-express-whole-unchanged-non-constant-target-with-any-candidate
                                                target-term
                                                target-value-for-each-trace
                                                candidate-component-value-for-each-trace-alist
                                                ;;(append component-traces-alist whole-candidate-traces-alist)
                                                terms-to-ignore
                                                consider-old-componentsp unchanged-components formal-to-old-var-alist))))))))))))))))

  ;; Returns a term or nil (meaning no explanation)
  ;; the target has the same value within each trace, but these values are not all the same (ffixme not necessarily true for one caller)
  (defun try-to-express-whole-unchanged-non-constant-target-with-any-candidate (target-term
                                                                                target-value-for-each-trace
                                                                                candidate-value-for-each-trace-alist ;walks down this one
                                                                                terms-to-ignore
                                                                                consider-old-componentsp ;whether to allow old versions of components that are not unchanged
                                                                                unchanged-components formal-to-old-var-alist)
    (if (endp candidate-value-for-each-trace-alist)
        nil
      (let* ((entry (first candidate-value-for-each-trace-alist))
             (candidate-term (car entry))
             (candidate-value-for-each-trace (cdr entry)))
        (or (try-to-express-whole-unchanged-non-constant-target-with-candidate target-term target-value-for-each-trace candidate-term candidate-value-for-each-trace terms-to-ignore
                                                                               consider-old-componentsp unchanged-components formal-to-old-var-alist)
            (try-to-express-whole-unchanged-non-constant-target-with-any-candidate target-term target-value-for-each-trace (rest candidate-value-for-each-trace-alist) terms-to-ignore
                                                                                   consider-old-componentsp unchanged-components formal-to-old-var-alist)))))))

(skip-proofs (verify-guards try-to-express-whole-unchanged-non-constant-target-with-candidate))

;; the target is unchanged within each trace.  it may or may not be constant between traces.
;; if a component is unchanged, the component term itself (not its "old" version) is what is used in the explanations.  otherwise, if we are allowed to consider old vals of components, the old val is used.
;; takes an option for whether we want to use old vars for non-unchanged candidate components
(defun try-to-express-whole-unchanged-target-with-any-candidate (target-term
                                                                 target-value-for-each-trace
                                                                 candidate-traces-alist
                                                                 terms-to-ignore
                                                                 formal-to-old-var-alist
                                                                 consider-old-componentsp ;whether to allow old versions of components that are not unchanged
                                                                 unchanged-components)
  (if (all-same target-value-for-each-trace)
      (enquote (first target-value-for-each-trace)) ;fixme what about empty traces? may be impossible since there is always a call (even if i just exits)?
    (try-to-express-whole-unchanged-non-constant-target-with-any-candidate target-term
                                                                           target-value-for-each-trace
                                                                           (pair-terms-with-first-values-for-each-trace candidate-traces-alist nil)
                                                                           terms-to-ignore
                                                                           consider-old-componentsp ;whether to allow old versions of components that are not unchanged
                                                                           unchanged-components formal-to-old-var-alist)))

(skip-proofs (verify-guards try-to-express-whole-unchanged-target-with-any-candidate))

;;what does this do?
;;the lengths of corresponding elements of target-traces and candidate-traces should be the same - may not be true?! - check in the caller! ffixme
(defun find-mult-and-div-sequences (target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore)
  (declare (ignore target-term terms-to-ignore)) ;don't pass these in!
  (prog2$ nil ;(cw "target traces lens: ~x0~%candidate traces lens: ~x1.~%" (len-list target-traces) (len-list candidate-traces))
          (mv-let (found-onep target-sequence candidate-sequence)
                  (find-long-enough-seqs target-traces candidate-traces) ;prevents crashes below?
                  (and found-onep
                       (let* ((target-diffs (get-diffs 'find-mult-and-div-sequences target-sequence)) ;this can crash
                              (candidate-diffs (get-diffs 'find-mult-and-div-sequences candidate-sequence)))
                         (if (and (all-same target-diffs)
                                  (all-same candidate-diffs))
;what about target = candidate mod 4?
                             (let ((target-diff (car target-diffs))
                                   (candidate-diff (car candidate-diffs)))
                               (if (and (not (equal 0 candidate-diff))
                                        ;;(integerp (/ target-diff candidate-diff))
                                        (equal 0 (sbvrem 32 target-diff candidate-diff)))
                                   ;;the target is changing more
                                   (let* ((ratio (/ target-diff candidate-diff)) ;or use sbvdiv?
;fixme instead of 32 here, use a value large enough to prevent any rollover or chopping?
                                          (pattern `(bvplus '32
                                                            ;fixme use bvuminus?
                                                            ',(bvminus 32
                                                                       (car target-sequence)
                                                                       ;;fixme use sbvdivdown here?
                                                                       (* ratio (car candidate-sequence)))
                                                            (bvmult '32 ',ratio place-holder-term))))
                                     (if (pattern-works-on-traces2 pattern target-traces candidate-traces whole-candidate-traces-alist)
                                         (sublis-var-simple (acons-fast 'place-holder-term candidate-term nil) pattern)
                                       nil))
                                 (if (and (not (equal 0 target-diff))
                                          ;;this "div" pattern can be shifted left or right a bit and still fit the sequence
                                          ;;we may need several sequences to see how it's shifted..
                                          (equal 0 (sbvrem 32 candidate-diff target-diff))
                                          ;;(integerp (/ candidate-diff target-diff)) ;;using "/" here was not quite right: consider target-diff is  *MINUS-1* and candidate-diff is 4294967292
                                          )
                                     ;;the candidate sequence is changing more (we'll have to scale it down)
                                     ;;the logext is because we had the sbvdivdown returning stuff like 4294967295
                                     (let* ((scale-factor (logext 32 (sbvdivdown 32 candidate-diff target-diff))) ;use sbvdiv?
                                            (patterns (possible-div-patterns scale-factor (car candidate-sequence)
                                                                             (car target-sequence)))
                                            (pattern (choose-working-pattern-if-exactly-one patterns target-traces
                                                                                            candidate-traces whole-candidate-traces-alist)))
                                       (if pattern ;(pattern-works-on-traces2 pattern target-traces candidate-traces whole-candidate-traces-alist)
                                           (sublis-var-simple (acons-fast 'place-holder-term candidate-term nil) pattern)
                                         nil))
;bozo
                                   nil)))
                           (if (and (eql 0 (car target-sequence)) ;gen!!
                                    (eql 0 (car candidate-sequence))
                                    (consecutivep candidate-sequence))
                               (let ((sawtooth-height (sawtooth-height target-sequence)))
                                 (if sawtooth-height
                                     (let ((pattern `(bvmod '32 place-holder-term ',sawtooth-height)))
                                       (if (pattern-works-on-traces2 pattern target-traces candidate-traces whole-candidate-traces-alist)
                                           (sublis-var-simple (acons-fast 'place-holder-term candidate-term nil) pattern)
                                         nil))
                                   nil))
                             nil)))))))

(skip-proofs (verify-guards find-mult-and-div-sequences))

;; find-difference-pattern:

(defun find-unchanged-sum-aux (target-trace candidate-trace possible-sum)
  (declare (type integer possible-sum)
           (xargs :guard (and (true-listp target-trace)
                              (true-listp candidate-trace))))
  (if (endp target-trace)
      possible-sum
    (let* ((sum (bvplus 32 (first target-trace) (first candidate-trace))))
      (and (eql sum possible-sum)
           (find-unchanged-sum-aux (rest target-trace) (rest candidate-trace) possible-sum)))))

;the traces must not be empty
(defun find-unchanged-sum (target-trace candidate-trace)
  (declare (xargs :guard (and (true-listp target-trace)
                              (true-listp candidate-trace))))
  (find-unchanged-sum-aux (rest target-trace)
                          (rest candidate-trace)
                          (bvplus 32 (first target-trace) (first candidate-trace))))

;if for each trace, the sum of the target and candidate is constant within the trace, this returns the list of such sums (one per trace)
;otherwise, this returns nil
(defun find-unchanged-sums-for-traces (target-traces candidate-traces sums-acc)
  (if (endp target-traces)
      (reverse-list sums-acc)
    (let* ((target-trace (first target-traces))
           (candidate-trace (first candidate-traces))
           (possible-unchanged-sum (find-unchanged-sum target-trace candidate-trace)))
      (if (not possible-unchanged-sum)
          nil
        (find-unchanged-sums-for-traces (rest target-traces) (rest candidate-traces) (cons possible-unchanged-sum sums-acc))))))

(skip-proofs (verify-guards find-unchanged-sums-for-traces))

;;the target is *not* unchanged within each trace.
;;the candidate is *not* unchanged within each trace (this is checked in find-difference-pattern)
;;target = U - candidate, where U is unchanged within each trace, and we can express U in terms of other stuff (U can be constant)
;;returns a pattern or nil
(defun find-difference-pattern (target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)
  (mv-let
   (found-onep target-sequence candidate-sequence) ;what about seqs of exactly 1?
   (find-long-enough-seqs target-traces candidate-traces) ;do we prevent analysis when all traces=1 (function immediately returns?)
   (declare (ignore target-sequence candidate-sequence))
   (and found-onep
        (let* ((should-try-it t
                              ;;                 ;;fixme check unchanged-components here?  what if a subterm (a larger piece of state) is unchanged?
                              ;;                 ;;think this over!
                              ;;                 (if (not (all-same target-sequence)) ;if each target-trace is all-same, don't do it? ;what if the seq. has len=1?
                              ;;                     t
                              ;;                   (and (all-same candidate-sequence) ;if the targets are all-same but the candidates aren't we would not be making progress
                              ;;                        ;; If the target sequence is all the same value (which must differ between traces),
                              ;;                        ;; don't waste time on this unless the candidate-sequence also differs between traces
                              ;;                        ;; So if target is (487 487 487 ..) and candidate is (1 1 1 ..) don't recur with target being (488 488 488 ..)
                              ;; ;ffixme this seems messed up - what if the traces have different lengths?!
                              ;;                        (not (all-equal$ candidate-sequence candidate-traces))
                              ;;                        ))
                              ))
          (prog2$
           nil ;(and should-try-it (cw "(trying diff pattern for target ~x0 and candidate ~x1.)~%" target-term candidate-term)) ;check print?
           (and should-try-it
                (let ((unchanged-sums (find-unchanged-sums-for-traces target-traces candidate-traces nil)))
                  (and unchanged-sums
                       (let* ( ;;we remove the traces for the candidate we are trying (we don't want to add or subtract it again):
                              ;;ffixme also remove the target we are trying to explain - should be done?
                              ;; if candidate-term is (len XX) this also removes keys of x, which can prevent loops:
                              ;;(cleared-whole-candidate-traces-alist (clearkeys-that-are-subterms candidate-term whole-candidate-traces-alist)) ;fixme drop this?
                              (sum-pattern (try-to-express-whole-unchanged-target-with-any-candidate
                                            `(bvplus '32 ,target-term ,candidate-term)
                                            unchanged-sums ;(strip-cars sum-traces)
                                            whole-candidate-traces-alist ;cleared-whole-candidate-traces-alist ;no need to clear, since it's okay (even good?) to express a var in terms of its own old-var?
                                            terms-to-ignore
                                            formal-to-old-var-alist
                                            t ;yes, allow old vars to appear
                                            unchanged-components)))
                         (and sum-pattern
                              `(bvminus '32 ,sum-pattern ,candidate-term)))))))))))

(skip-proofs (verify-guards find-difference-pattern))

;; find-sum-pattern:

(defun find-unchanged-difference-aux (target-trace candidate-trace possible-difference)
  (declare (type integer possible-difference)
           (xargs :guard (and (true-listp target-trace)
                              (true-listp candidate-trace))))
  (if (endp target-trace)
      possible-difference
    (let* ((difference (bvminus 32 (first target-trace) (first candidate-trace))))
      (and (eql difference possible-difference)
           (find-unchanged-difference-aux (rest target-trace) (rest candidate-trace) possible-difference)))))

;the traces must not be empty
(defun find-unchanged-difference (target-trace candidate-trace)
  (declare (xargs :guard (and (true-listp target-trace)
                              (true-listp candidate-trace))))
  (find-unchanged-difference-aux (rest target-trace)
                                 (rest candidate-trace)
                                 (bvminus 32 (first target-trace) (first candidate-trace))))

;if for each trace, the difference of the target and candidate is constant within the trace, this returns the list of such differences (one per trace)
;otherwise, this returns nil
(defun find-unchanged-differences-for-traces (target-traces candidate-traces differences-acc)
  (if (endp target-traces)
      (reverse-list differences-acc)
    (let* ((target-trace (first target-traces))
           (candidate-trace (first candidate-traces))
           (possible-unchanged-difference (find-unchanged-difference target-trace candidate-trace)))
      (if (not possible-unchanged-difference)
          nil
        (find-unchanged-differences-for-traces (rest target-traces)
                                               (rest candidate-traces)
                                               (cons possible-unchanged-difference differences-acc))))))

(skip-proofs (verify-guards find-unchanged-differences-for-traces))

;;the target is *not* unchanged within each trace.
;;the candidate is *not* unchanged within each trace (this is checked in find-difference-pattern)
;;target = U + candidate, where U is unchanged within each trace, and we can express U in terms of other stuff (U can be constant)
;;returns a pattern or nil
(defun find-sum-pattern (target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)
  (mv-let
   (found-onep target-sequence candidate-sequence) ;what about seqs of exactly 1?
   (find-long-enough-seqs target-traces candidate-traces) ;do we prevent analysis when all traces=1 (function immediately returns?)
   (declare (ignore target-sequence candidate-sequence))
   (and found-onep
        (prog2$
         nil ;(cw "(trying sum pattern for target ~x0 and candidate ~x1.)~%" target-term candidate-term) ;check print?
         (let ((unchanged-differences (find-unchanged-differences-for-traces target-traces candidate-traces nil)))
           (and unchanged-differences
                (let ((unchanged-term `(bvplus '32 ,target-term ,candidate-term)))
                  (prog2$
                   (cw "The value ~x0 is unchanged per trace." unchanged-term)
                   (let* ( ;;we remove the traces for the candidate we are trying (we don't want to add or subtract it again):
                          ;;ffixme also remove the target we are trying to explain - should be done?
                          ;; if candidate-term is (len XX) this also removes keys of x, which can prevent loops:
                          ;;(cleared-whole-candidate-traces-alist (clearkeys-that-are-subterms candidate-term whole-candidate-traces-alist)) ;fixme drop this?
                          (difference-pattern (try-to-express-whole-unchanged-target-with-any-candidate
                                               unchanged-term
                                               unchanged-differences
                                               whole-candidate-traces-alist ;cleared-whole-candidate-traces-alist ;no need to clear, since it's okay (even good?) to express a var in terms of its own old-var?
                                               terms-to-ignore
                                               formal-to-old-var-alist
                                               t ;yes, allow old vars to appear
                                               unchanged-components)))
                     (and difference-pattern
                          (if (equal difference-pattern ''0)
                              `(bvplus '32 ,difference-pattern ,candidate-term) ;fffixme not possible? or simplify this?
                            `(bvplus '32 ,difference-pattern ,candidate-term))))))))))))

(skip-proofs (verify-guards find-sum-pattern))

;; ;;target = value + C
;; ;returns a pattern for target in terms of value, or nil
;; ;ffixme change this to be like find-difference-pattern!
;; (defun find-sum-pattern (target-sequence ;what if this happens to be empty?
;;                          value-sequence ;what if this happens to be empty?
;;                          target-traces value-traces
;;                          whole-value-traces-alist value-term)
;;   (let ((difference-lst-32 (bvminus-list 32 target-sequence value-sequence))) ;gen the 32? ;avoid consing this up?
;;     (if (and (all-same difference-lst-32) ;fixme the constant difference should be able to differ on different test cases
;;              (pattern-works-on-traces2 `(bvplus '32 ',(car difference-lst-32) place-holder-term)
;;                                        target-traces value-traces whole-value-traces-alist))
;;         `(bvplus '32 ',(car difference-lst-32) ,value-term)
;;       nil)))

;; (skip -proofs (verify-guards find-sum-pattern))



;;                 (let ((sum-trace (bvplus-list 32 target-sequence candidate-sequence))) ;gen the 32? ;avoid consing this up?
;; ;could speed this up by combining the all-same and the bvplus-list..
;;                   (and (all-same sum-trace) ;this constant sum might be different on different test cases
;; ;make sure for each trace the sum-lst is a repeated constant (not necessarily the same constant on every trace)
;;                        (let* ((sum-traces (bvplus-list-list 32 target-traces candidate-traces)) ;fixme think about the 32
;;                               )
;; ;this test prevents us from considering sums of many params - lots of subsets to try...
;;                          (and (all-all-same sum-traces)
;;                               ))))))))))

;tests for target = candidate mod modulus
(defun mod-pattern-works-on-trace (target-trace candidate-trace modulus-trace)
  ;; (declare (xargs :guard (true-listp target-trace)))
  (if (endp target-trace)
      t
    (let ((modulus (first modulus-trace)))
      (and (< 0 modulus)
           (equal (first target-trace) (bvmod 31 (first candidate-trace) modulus))
           (mod-pattern-works-on-trace (rest target-trace) (rest candidate-trace) (rest modulus-trace))))))

(skip-proofs (verify-guards mod-pattern-works-on-trace))

(defun mod-pattern-works-on-all-traces (target-traces candidate-traces modulus-traces)
  (if (endp target-traces)
      t
    (and (mod-pattern-works-on-trace (first target-traces) (first candidate-traces) (first modulus-traces))
         (mod-pattern-works-on-all-traces (rest target-traces) (rest candidate-traces) (rest modulus-traces)))))

(skip-proofs (verify-guards mod-pattern-works-on-all-traces))

(skip-proofs
 (mutual-recursion
 ;;returns a pattern or nil
 (defun find-mod-pattern-in-tree (target-term target-traces candidate-term candidate-traces
                                              modulus-term ;the tree we are searching
                                              modulus-traces
                                              terms-to-ignore)
   (if (member-equal modulus-term terms-to-ignore) ;think about this
       nil
     (if (all-integer-listp modulus-traces)
         (if (mod-pattern-works-on-all-traces target-traces candidate-traces modulus-traces)
             (let ((mod-pattern `(bvmod '31 ,candidate-term ,modulus-term)))
               (prog2$ (cw "(Found mod pattern for ~x0, namely ~x1.)~%" target-term mod-pattern)
                       mod-pattern))
           nil)
       ;;maybe it's a list we can deconstruct
       (if (not (nil-or-consp-list-list modulus-traces))
           nil
         ;; it's a list:
         (let* ((length-traces (len-list-list candidate-traces)) ;slow?
                (len (first (first length-traces)))
                )
           (if (mod-pattern-works-on-all-traces target-traces candidate-traces length-traces)
               (let ((mod-pattern `(bvmod '31 ,candidate-term (len ,modulus-term))))
                 (prog2$ (cw "(Found mod pattern for ~x0, namely ~x1.)~%" target-term mod-pattern)
                         mod-pattern))
             ;;try the components, if the lists are always the same length
             (and (len-equal-list-list modulus-traces len)
                  (find-mod-pattern-in-tree target-term target-traces candidate-term candidate-traces
                                            (make-nth-terms len modulus-term)
                                            (get-nths-from-traces len modulus-traces)
                                            terms-to-ignore))))))))

 ;;returns a pattern or nil
 (defun find-mod-pattern-in-trees (target-term target-traces candidate-term candidate-traces
                                               modulus-term-lst ;the trees we are searching
                                               modulus-traces-lst
                                               terms-to-ignore)
   (if (endp modulus-term-lst)
       nil
     (or (find-mod-pattern-in-tree target-term target-traces candidate-term candidate-traces (first modulus-term-lst) (first modulus-traces-lst) terms-to-ignore)
         (find-mod-pattern-in-trees target-term target-traces candidate-term candidate-traces (rest modulus-term-lst) (rest modulus-traces-lst) terms-to-ignore))))))

(skip-proofs (verify-guards find-mod-pattern-in-tree))

;try to express target as candidate mod <something>
;if target repeetedly increases and then falls back down, in a sawtooth pattern, we could try to explain the heights of the sawtooth (that's the modulus), but some traces may not reach the peak of the first tooth
;;returns a pattern or nil
;walks down whole-traces-alist looking for the modulus
;the target-traces and the candidate-traces should not be exactly the same
;;fixme could require the modulus to be unchanged?
(defun find-mod-pattern (target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore)
  (if (endp whole-candidate-traces-alist)
      nil
    (let* ((entry (first whole-candidate-traces-alist))
           (modulus-term (car entry))
           (modulus-traces (cdr entry)))
      (let ((pattern (find-mod-pattern-in-tree target-term target-traces candidate-term candidate-traces modulus-term modulus-traces terms-to-ignore)))
        (or pattern
            (find-mod-pattern target-term target-traces candidate-term candidate-traces (rest whole-candidate-traces-alist) terms-to-ignore))))))

(skip-proofs (verify-guards find-mod-pattern))

(skip-proofs
 (mutual-recursion

  ;;(FIND-BASIC-PATTERN '(16 12 8 4 0) '(0 1 2 3 4) ...)
  ;;(FIND-BASIC-PATTERN '(16 12 8 4 0) '(1 2 3 4 5) ...)

  ;;returns nil, or a pattern for TARGET-TERM in terms of CANDIDATE-TERM and the keys of WHOLE-CANDIDATE-TRACES-ALIST (except those we have been told to ignore?)
  ;;the target is *not* unchanged within each trace
  ;;special case when all elements of target-traces are the same and also all elems of candidate-traces are the same?
  ;;fixme if the candidate traces are the same and the target traces aren't there's no answer - handle that case - done? not necessarily true because whole-candidate-traces-alist can cause variations?
  ;; what if the first trace is for a random list length of 0 or something and so is highly atypical? - do we now handle this?
  ;;does this require that target-term, candidate-term (or super or sub terms of them) are not in whole-candidate-traces-alist?)
;this should not deconstruct the candidate term - check that
  (defun find-basic-pattern (target-term target-traces candidate-term candidate-traces
                                         whole-candidate-traces-alist
                                         terms-to-ignore
                                         formal-to-old-var-alist unchanged-components)
    (declare (xargs :measure 1)) ;fixme
    (let ( ;(dummy (cw "Explaining ~x0 with ~x1, ignoring ~x2.~%" target-term candidate-term terms-to-ignore))
          (target-sequence (car target-traces)) ;try not to use these, since they may be atypical?
          (candidate-sequence (car candidate-traces)))
      (cond
       ;;if the targets always equal the candidates:
       ((equal target-traces candidate-traces) candidate-term)
       ;;if the candidates are all the same (but the targets aren't - tested above), there's no function that can generate them - fixme what about combining candidate-sequence with some from whole-candidate-traces-alist? ;fixme actually, the above requires not only that all targets are the same but that the pattern works on all traces
       ;;trying without this (due to a need for an nthcdr pattern in rc4 when the candidate being nthcdred is always the same)
       ;;fffixme think this through! quite tricky...
;what if on each trace i the candidates are all some v_i and the targets are all some t_i?
       ((and (all-all-same candidate-traces)
;(< 1 (len candidate-sequence)) ;new
;check all the traces here?:
             (all-integerp candidate-sequence)) ;if they are lists, we now keep going..
        nil)
       ;;the targets and candidates are integers:
       ((and (all-integer-listp target-traces)
             (all-integer-listp candidate-traces))
        ;;fixme - do much more here
        (or (find-slice-pattern target-traces candidate-traces candidate-term)
;            (find-sum-pattern target-sequence candidate-sequence target-traces candidate-traces whole-candidate-traces-alist candidate-term)
            (find-sum-pattern target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)
            (find-difference-pattern target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)
            (find-mult-and-div-sequences target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore)
            (find-mod-pattern target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore)
            ))
       ;;the candidates are integer sequences (arrays or lists): - or the targets are! ffixme what if exactly one is?
       ((and (consp target-sequence) ;fixme what if the first sequence happens to be for a test case of 0 length?
             (all-true-listp target-sequence)
             (all-all-integerp target-sequence) ;check all the traces?  ;careful! (all-all-integerp '(1 2)) = t
             (consp candidate-sequence) ;fixme what if the first sequence happens to be for a test case of 0 length?
             (all-true-listp candidate-sequence)
             (all-all-integerp candidate-sequence))
        (prog2$ nil ;(cw "Integer sequences.~%")

                ;;ffixme the firstn and nthcdr patterns can cause loops, e.g., when we have (equal x (firstn (len x) y))
                ;; or (equal x (firstn y1 y2)) and (equal y1 (len x))
                ;;perhaps use prefixp and suffixp? now we use prefixp instead of firstn.  make an analogous change for nthdcr?  would need rules about suffixp..

                ;; we shouldn't get all 0's here, because we checked above for target=candidate
                (let* ((dummy nil) ;(cw "len of target-traces: ~x0. len of candidate-traces: ~x1~%" (len target-traces) (len candidate-traces))
                       (nth-traces-for-nthcdr (make-nth-list-for-nthcdr-list target-traces candidate-traces)))
                  (declare (ignore dummy))
                  (if nth-traces-for-nthcdr
                      (let* ( ;;this is in terms of 'whole-candidate-place-holder-term: - no?
                             (nth-pattern
                              (prog2$ nil ;(cw "trying to find a pattern for the nths: ~x0 in the whole traces: ~x1.~%"
;nth-traces-for-nthcdr whole-candidate-traces-alist)
;do we have to search for the nth, or can we just write (- (len candidate) (len target))? - maybe it's not okay to mention target..
                                      (try-to-express-whole-target-with-any-candidate 'fake-target-term-for-nthcdr
                                                                                      nth-traces-for-nthcdr
                                                                                      whole-candidate-traces-alist
                                                                                      terms-to-ignore formal-to-old-var-alist
                                                                                      unchanged-components))))
                        ;; do we need to check the pattern here?  I think not...
;there used to be a check here, but it caused problems when the keys of whole-candidate-alist weren't symbols - maybe that restriction can be dropped?
                        (if nth-pattern
                            (prog2$ (cw ",,nthcdr-pattern: ~x0~%" nth-pattern)
                                    `(nthcdr ,nth-pattern ,candidate-term))
                          nil))

;this firstn stuff could cause loops.  now we use the prefix operator (but it's not an explanation, so we detect it elsewhere)
                    ;;                      (let* ((nth-traces-for-firstn (make-nth-list-for-firstn-list target-traces candidate-traces)))
                    ;;                        (if nth-traces-for-firstn
                    ;;                            (let* ( ;;this is in terms of 'whole-candidate-place-holder-term:
                    ;;                                   (nth-pattern
                    ;;                                    (prog2$ nil ;(cw "trying to find a pattern for the nths: ~x0 in the whole traces: ~x1.~%" nth-traces-for-nthcdr whole-candidate-traces-alist)
                    ;; ;do we have to search for the nth, or can we just write (- (len candidate) (len target))? - maybe it's not okay to mention target..
                    ;;                                            (try-to-express-whole-target-with-any-candidate 'fake-target-term-for-firstn
                    ;;                                                                                        0
                    ;;                                                                                        nth-traces-for-firstn
                    ;;                                                                                        whole-candidate-traces-alist
                    ;;                                                                                        terms-to-ignore))))
                    ;;                              ;; do we need to check the pattern here?  I think not...
                    ;; ;there used to be a check here, but it caused problems when the keys of whole-candidate-alist weren't symbols - maybe that restriction can be dropped?
                    ;;                              (if nth-pattern
                    ;;                                  (prog2$ (cw ",,firstn-pattern: ~x0~%" nth-pattern)
                    ;;                                          `(firstn ,nth-pattern ,candidate-term))
                    ;;                                nil))
                    ;;                          nil))
                    nil
                    ))))
       (t nil))))

  ;;the target is *not* unchanged within each trace
  ;;Returns nil or a term representing TARGET-TERM in terms of CANDIDATE-TERM and the cars of WHOLE-CANDIDATE-TRACES-ALIST
  ;;this deconstructs the candidate (which may be a tree) but does not deconstruct the target (so success means that we completely explain the target)
  ;;fixme this assumes all of the candidates have the same shape!
  ;;term should not be equal to candidate-term or any key of whole-candidate-traces-alist - fixme think about this
  (defun try-to-express-whole-non-unchanged-target-with-candidate (target-term target-traces candidate-term candidate-traces whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)
    (declare (xargs :measure (acl2-count target-term))) ;;fixme bogus
    (if (member-equal candidate-term terms-to-ignore)
        (prog2$ (cw "(Explaining ~x0 with ~x1 is disallowed to prevent loops.)~%" target-term candidate-term)
                nil)
      ;;first try to use the whole candidate:
      (let ( ;(cleared-whole-candidate-traces-alist (alist::clearkey candidate-term whole-candidate-traces-alist)) ;why did i remove this clearing?
            (possible-pattern (find-basic-pattern target-term target-traces candidate-term candidate-traces
                                                  whole-candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)))
        (or possible-pattern
            ;;now consider the pieces of candidate:
            (and (nil-or-consp-list-list candidate-traces) ;if the candidates are not lists, fail (fixme could consider the individual bits of integer candidates)
                 ;;if the candidates are lists, make the list of their lengths and look for a pattern: (fixme don't do this when dropping params?)
                 ;;fixme should find-basic-pattern do this? not sure..
;ffixme check if all the lens are the same - if so, consider the pieces (the lengths probably won't help explain the target).  if not, try to use the lengths to explain the target

                 (let* ((length-term `(len ,candidate-term))
                        ;;we avoid building the length-traces if they are not needed:
                        (disallowedp (if (member-equal length-term terms-to-ignore)
                                         (prog2$ (cw "(Explaining ~x0 with ~x1 is disallowed to prevent loops.)~%" target-term length-term)
                                                 t)
                                       nil))
                        (length-traces (if disallowedp
                                           nil ;means length-traces is invalid
                                         (len-list-list candidate-traces))))
                   (or ;;fixme what if the length is unchanged within each trace? call the -unchanged version of stuff? or just fail (since the targets are not unchanged)???
                    ;;try to explain the target using the lengths of the candidates:
                    (and length-traces
                         (find-basic-pattern target-term target-traces length-term length-traces
                                             ;;cleared-
                                             whole-candidate-traces-alist
                                             terms-to-ignore formal-to-old-var-alist unchanged-components))
                    ;; No pattern from the length, so consider the pieces in turn:
                    (let* ( ;(first-candidate-trace (first candidate-traces))
                           ;;(first-candidate (first first-candidate-trace))
                           (first-candidate (find-a-val-in-traces candidate-traces))
                           (len (len first-candidate)))
                      ;;fixme can we drop this??
                      (and ;;avoids considering values of large arrays (continue if the tuple is small or not homogeneous):
                       (or (< len 32) ;ffixme..
                           (not (integer-listp first-candidate))
                           )
                       ;;ensure the lists are all of the same lengths:
                       (if length-traces ;if we computed the valid length-traces above, use them here:
                           (and (all-same (strip-cars length-traces)) ;first length of each trace the same (fixme save the consing done by the strip-cars)
                                (all-all-same length-traces) ;length the same within each trace
                                )
                         (len-equal-list-list candidate-traces len))

                       ;;would like to avoid the consing here?:
                       (let* ((component-traces-lst (get-nths-from-traces len candidate-traces)) ;a 3-D list?!
                              (component-term-lst (make-nth-terms len candidate-term))
                              (component-traces-alist (pairlis$ component-term-lst component-traces-lst)))
                         (try-to-express-whole-non-unchanged-target-with-any-candidate
                          target-term
                          target-traces
                          ;;note that these alists differ:
                          component-traces-alist
                          (append component-traces-alist
                                  whole-candidate-traces-alist)
                          terms-to-ignore formal-to-old-var-alist unchanged-components)))))))))))

  ;;takes a single target and an alist pairing candidate terms with their trace lists
  ;;does not deconstruct the target
  ;;returns nil, or a term representing TARGET-TERM in terms of the cars of CANDIDATE-TRACES-ALIST and WHOLE-CANDIDATE-TRACES-ALIST
  ;;walks down candidate-traces-alist (but keeps whole-candidate-traces-alist)
  ;;whole-candidate-traces-alist may actually have more stuff in it than candidate-traces-alist? (e.g., if candidate-traces-alist has the pieces of a single candidate)
  ;;target-term should not be a key of either candidate-traces-alist or whole-candidate-traces-alist
  ;;the target does not have the same value within each trace (and so is definitely not constant)
  (defun try-to-express-whole-non-unchanged-target-with-any-candidate (target-term target-traces
                                                                                   candidate-traces-alist ;walks down this one
                                                                                   whole-candidate-traces-alist
                                                                                   terms-to-ignore formal-to-old-var-alist unchanged-components)
    (if (endp candidate-traces-alist)
        nil
      (let* ((entry (first candidate-traces-alist))
             (candidate-term (car entry))
             (candidate-traces (cdr entry)))
        (or (try-to-express-whole-non-unchanged-target-with-candidate target-term
                                                                      target-traces
                                                                      candidate-term
                                                                      candidate-traces
                                                                      whole-candidate-traces-alist
                                                                      terms-to-ignore formal-to-old-var-alist unchanged-components)
            (try-to-express-whole-non-unchanged-target-with-any-candidate target-term
                                                                          target-traces
                                                                          (cdr candidate-traces-alist)
                                                                          whole-candidate-traces-alist
                                                                          terms-to-ignore formal-to-old-var-alist unchanged-components)))))

  ;;targets may also just be constants
  ;;returns nil, or a term representing TARGET-TERM in terms of the cars of CANDIDATE-TRACES-ALIST and WHOLE-CANDIDATE-TRACES-ALIST
  (defun try-to-express-whole-target-with-any-candidate (target-term target-traces candidate-traces-alist
                                                                     terms-to-ignore ;will be keys of candidate-traces-alist(?) that banned from explanations. fixme what does this do with subterms and superterms?  maybe that's handled when we create or extend this alist?
                                                                     formal-to-old-var-alist
                                                                     unchanged-components)
    (declare (xargs :measure (acl2-count target-term))) ;;fixme bogus
    ;;first check whether the targets are all the same constant (and so don't depend on the candidates at all):
    (if (all-all-same target-traces) ;target is unchanged within each trace (may or may not be constant between traces):
        (try-to-express-whole-unchanged-target-with-any-candidate target-term (strip-cars target-traces) candidate-traces-alist terms-to-ignore formal-to-old-var-alist
                                                                  nil ;no, don't let old vars appear directly
                                                                  unchanged-components)
      (try-to-express-whole-non-unchanged-target-with-any-candidate target-term target-traces candidate-traces-alist candidate-traces-alist terms-to-ignore formal-to-old-var-alist unchanged-components)))))

(skip-proofs (verify-guards try-to-express-whole-target-with-any-candidate))

(skip-proofs
 (mutual-recursion

  ;;returns nil or a prefix pattern
  ;;this deconstructs the value (which may be a tree) but does not deconstruct the target
  (defun find-prefixp-pattern-with-value (target-term target-traces value-term value-traces)
    (declare (xargs :measure  (acl2-count target-term))) ;;fixme bogus
    ;;first try to use the whole value:
    (if (all-all-prefixp target-traces value-traces)
        (prog2$ (cw "prefix pattern for ~x0 and ~x1.~%" target-term value-term)
                `(prefixp ,target-term ,value-term))
      ;;try to deconstruct the values (if they are lists of the same length):
      (if (not (nil-or-consp-list-list value-traces))
          ;; the values are not lists:
          nil
        (let* ((value (find-a-val-in-traces value-traces))
               (len (len value)))
          (if (not (len-equal-list-list value-traces len))
              ;; the values are don't all have the same length:
              nil
            ;; the values are lists of the same length:
            (let* ((nth-traces-lst (get-nths-from-traces len value-traces)) ;fixme slow to cons this up?
                   (nth-terms (make-nth-terms len value-term)))
              (find-prefixp-pattern-with-value-lst target-term target-traces nth-terms nth-traces-lst)))))))

  (defun find-prefixp-pattern-with-value-lst (target-term target-traces value-terms value-traces-lst)
    (declare (xargs :measure (acl2-count target-term))) ;fixme bogus
    (if (endp value-terms)
        nil
      (or (find-prefixp-pattern-with-value target-term target-traces (first value-terms) (first value-traces-lst))
          (find-prefixp-pattern-with-value-lst target-term target-traces (rest value-terms) (rest value-traces-lst)))))))

(skip-proofs (verify-guards find-prefixp-pattern-with-value))

; returns a claim, or nil
(defun find-prefixp-pattern-with-any-value (target-term target-traces value-traces-alist)
  (if (endp value-traces-alist)
      nil
    (let* ((entry (car value-traces-alist))
           (value-term (car entry))
           (value-traces (cdr entry))
           (possible-pattern (find-prefixp-pattern-with-value target-term target-traces value-term value-traces))
           )
      (or possible-pattern
          (find-prefixp-pattern-with-any-value target-term target-traces (cdr value-traces-alist))))))

(skip-proofs (verify-guards find-prefixp-pattern-with-any-value))

;; graphs represented as list of edges
;; used for detecting loops in explanations

(defun empty-explanation-graph () nil)

(defun get-nodes-pointed-to (node graph acc)
  (if (endp graph)
      acc
    (let* ((entry (first graph))
           (node1 (car entry)))
      (get-nodes-pointed-to node
                            (rest graph)
                            (if (equal node1 node)
                                (cons (cdr entry) acc)
                              acc)))))

(defun add-pointed-to-nodes (node1 node2s acc)
  (if (endp node2s)
      acc
    (add-pointed-to-nodes node1 (rest node2s)
                          (cons (cons node1 (first node2s))
                                acc))))

;returns (mv changep graph) where graph may extend acc
(defun add-implied-pairs (graph whole-graph changep acc)
  (if (endp graph)
      (mv changep acc)
    (let* ((entry (car graph))
           (node1 (car entry))
           (node2 (cdr entry))
           (nodes-node2-points-to (get-nodes-pointed-to node2 whole-graph nil))
           (nodes-node1-points-to (get-nodes-pointed-to node1 acc nil))
           (new-nodes-for-node1-to-point-to (set-difference-equal nodes-node2-points-to nodes-node1-points-to)))
      (add-implied-pairs (cdr graph)
                         whole-graph
                         (or changep (consp new-nodes-for-node1-to-point-to))
                         (add-pointed-to-nodes node1 new-nodes-for-node1-to-point-to acc)))))

;the graph is a list of pairs that represent edges
(skip-proofs
 (defun closure-of-graph (graph)
   (mv-let (changep graph)
           (add-implied-pairs graph graph nil graph)
           (if changep
               (closure-of-graph graph)
             graph))))

(defun get-subterms-of-nth-and-len-nest (term acc)
  (if (not (consp term))
      (add-to-set-equal term acc)
    (if (call-of 'nth term)
        (get-subterms-of-nth-and-len-nest (farg2 term) (add-to-set-equal term acc))
      (if (call-of 'len term)
          (get-subterms-of-nth-and-len-nest (farg1 term) (add-to-set-equal term acc))
        (add-to-set-equal term acc)))))

(defun get-subterms-of-nth-and-len-nests (terms acc)
  (if (endp terms)
      acc
    (get-subterms-of-nth-and-len-nests (rest terms)
                                       (get-subterms-of-nth-and-len-nest (first terms) acc))))

;handling of len is new
(mutual-recursion
 (defun get-mentioned-arg-components-aux2 (term)
   (if (atom term)
       (list term)
     (if (quotep term)
         nil
       (if (nth-nest-around-symbolp term)
           (list term)
         (if (and (call-of 'len term)
                  (nth-nest-around-symbolp (farg1 term)))
             (list term (farg1 term))
           (get-mentioned-arg-components-aux2-lst (fargs term)))))))

 (defun get-mentioned-arg-components-aux2-lst (terms)
   (if (endp terms)
       nil
     (append (get-mentioned-arg-components-aux2 (car terms))
             (get-mentioned-arg-components-aux2-lst (cdr terms))))))

;;when adding (equal (nth 0 x) (nth 1 y)), we add the pair (nth 0 x)->(nth 1 y)
;;we also add x->S for each subterm S of y
;;here "subterms" of (nth 1 y) would be (nth 1 y) and y
;;then compute the closure of the alist
;;later, when seeking to explain a term T, we ignore all terms s such that s->T appears in the database (and stop the recursion in the tree when we hit any such a term)
;; when we specify the terms to ignore, that applies implicitly to superterms (which represent smaller pieces of state).
;;so if we add the explan (equal (nth 0 x) (nth 1 y))
;;then later when explaining (nth 1 y) we cannot use (nth 0 x) and so also don't dive into (nth 0 (nth 0 x)), etc.
;what about lengths it's just like nth:
;when adding (equal (nth 0 x) (len y)) we add the pairs (nth 0 x)->(len y) and (nth 0 x)->y.  this reflects the fact that neither y nor len y should be explained in terms of (nth 0 x).
;example: (update-explanation-graph '(nth '0 x) '(nth '1 y) (empty-explanation-graph))
(defun update-explanation-graph (term explanation graph)
  (prog2$
   (cw "(Explaining ~x0 as ~x1.)" term explanation)
   (let* ((components-in-explanation (get-mentioned-arg-components-aux2 explanation))
          (explanation-subterms (get-subterms-of-nth-and-len-nests components-in-explanation nil))
          (graph (add-pointed-to-nodes term explanation-subterms graph))
          (graph (closure-of-graph graph)))
     (prog2$ (and ;print
              (cw "(new explanation graph: ~x0)~%" graph)) ;fixme eventually pass in print and check it before printing
             graph))))

(defun get-nodes-that-point-to (node graph acc)
  (if (endp graph)
      acc
    (let* ((entry (first graph))
           (node2 (cdr entry)))
      (get-nodes-that-point-to node
                               (rest graph)
                               (if (equal node2 node)
                                   (cons (car entry) acc)
                                 acc)))))

;fixme think about subterms/superterms. i guess they are handled right when we add to the graph?
(defun get-terms-to-ignore (term graph)
  (get-nodes-that-point-to term graph nil))

;; (defun okay-to-explain-term-using-candidate (term candidate graph)
;;   (not (member-equal (cons candidate term) graph)))

;all values V such than explans contains (equal V target)
(defun terms-equated-to (target explans)
  (if (endp explans)
      nil
    (let ((explan (first explans)))
      (if (and (call-of 'equal explan)
               (equal target (farg2 explan)))
          (cons (farg1 explan)
                (terms-equated-to target (rest explans)))
        (terms-equated-to target (rest explans))))))

(skip-proofs
 (mutual-recursion
  ;;the target is a tree.  first we try to express the whole thing.  then we
  ;;try to express the length and each piece, recursively.
  ;;returns (mv explanation-graph explanations) where explanations is an extension of acc
  ;; where explanations extends acc and is a list of equalities about TARGET-TERM and the keys of VALUE-TRACES-ALIST.  (Since
  ;;we may not be able to express the whole term, we can't just return an explanation term).
  ;;ffixme what about a term that's the same constant in every trace?!
  ;;explans is all previously generated explans from values to targets
  (defun try-to-express-target-tree-with-any-value (target-term target-traces value-traces-alist formal-to-old-var-alist unchanged-components explanation-graph explans acc)
    (declare (xargs :measure (len target-term))) ;fake
    (let ((whole-pattern (try-to-express-whole-target-with-any-candidate
                          target-term
                          target-traces value-traces-alist
                          (get-terms-to-ignore target-term explanation-graph)
                          formal-to-old-var-alist
                          unchanged-components)))
      (if whole-pattern
          (mv (update-explanation-graph target-term whole-pattern explanation-graph)
              (cons `(equal ,target-term ,whole-pattern) acc))
        (if (not (nil-or-consp-list-list target-traces))
            ;; it isn't a list:  ;fixme could try to express individual bits of the target?
            (mv explanation-graph acc)
          ;; the targets are lists:
          (let* ((value (find-a-val-in-traces target-traces))
                 (len (len value)))
            (if (len-equal-list-list target-traces len)
                ;; all the targets are the same length (that length will be found as a type fact?).  try to express the pieces:
;fffixme should we try a prefix pattern in this case too?
                (if (and (or (< len 32) ;fixme - hack?
                             (not (integer-listp value)))
                         ;(not (member-equal `(equal ,value-term ,target-term) explans)) ;check that value has not already been explained by the target (okay if value goes to a subterm (larger piece of data) than the target in the graph?)
                         )
                    ;;deconstruct the target and try to express the pieces:
                    (try-to-express-target-tree-list-with-any-value
                     ;;no longer reversing this (to match what we do elsewhere):
                     (get-nths-from-traces len target-traces)
                     (make-nth-terms len target-term)
                     (clear-keys (terms-equated-to target-term explans) ;Sun Feb 27 13:54:21 2011
                                 value-traces-alist)
                     formal-to-old-var-alist unchanged-components explanation-graph explans acc)
                  (mv explanation-graph acc))
              ;;the targets are not all the same length:
              (let* ((length-traces (len-list-list target-traces))
                     (length-term `(len ,target-term))
                     ;; may be nil:
                     (length-explanation (try-to-express-whole-target-with-any-candidate length-term length-traces value-traces-alist
                                                                                         (get-terms-to-ignore length-term explanation-graph)
                                                                                         formal-to-old-var-alist unchanged-components))
                     (explanation-graph (if length-explanation (update-explanation-graph length-term length-explanation explanation-graph) explanation-graph))
                     (acc (if length-explanation (cons `(equal ,length-term ,length-explanation) acc) acc))

                     (prefix-pattern (find-prefixp-pattern-with-any-value target-term target-traces value-traces-alist))
                     ;;fixme should this cause anything to be added to explanation-graph to prevent loops?
                     (acc (if prefix-pattern (cons prefix-pattern acc) acc))
                     )
                (mv explanation-graph acc))))))))

  ;;returns (mv explanation-graph explanations) where explanations is an extension of acc
  (defun try-to-express-target-tree-list-with-any-value (target-traces-lst target-term-lst value-traces-alist formal-to-old-var-alist unchanged-components explanation-graph explans acc)
    (declare (xargs :measure (len target-traces-lst)))
    (if (endp target-traces-lst)
        (mv explanation-graph acc)
      (mv-let (explanation-graph acc)
              (try-to-express-target-tree-with-any-value (first target-term-lst) (first target-traces-lst) value-traces-alist formal-to-old-var-alist unchanged-components explanation-graph
                                                         explans acc)
              (try-to-express-target-tree-list-with-any-value (rest target-traces-lst) (rest target-term-lst) value-traces-alist formal-to-old-var-alist unchanged-components explanation-graph
                                                              explans acc))))))


;each key is paired with a list of values.  we add value to that list for each key in KEYS
(defun add-value-for-each-key (keys value alist)
  (if (endp keys)
      alist
    (let* ((key (first keys))
           (old-values (lookup-equal key alist))
           (new-values (add-to-set-equal value old-values))
           (alist (acons-unique key new-values alist)))
      (add-value-for-each-key (rest keys) value alist))))

(defun add-values-for-each-key (keys values alist)
  (if (endp keys)
      alist
    (let* ((key (first keys))
           (old-values (lookup-equal key alist))
           (new-values (union-equal values old-values))
           (alist (acons-unique key new-values alist)))
      (add-values-for-each-key (rest keys) values alist))))

;add TERM to the list of values for each key whose values include any of the TARGET-TERMS
(defun add-value-for-each-key-with-some-value (term target-terms alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry))
           (values (cdr entry)))
      (if (intersection-equal values target-terms) ;fixme - no need to compute the whole intersection..
          (acons-fast key
                      (add-to-set-equal term values)
                      (add-value-for-each-key-with-some-value term target-terms (cdr alist)))
        (acons-fast key
                    values
                    (add-value-for-each-key-with-some-value term target-terms (cdr alist)))))))

;; ;We have discovered that TERM is probably equal to EXPLANATION.  The amounts to adding the directed equality TERM->EXPLANATION.
;; ;;
;; ;;add terms to ignore when we add
;; (defun add-terms-to-ignore (term explanation terms-to-ignore-alist)
;;   (let* ((components-in-explanation (get-mentioned-arg-components-aux2 explanation)) ;does not get sub-components, i guess..
;;          ;fixme kind of a hack?
;;          (components-in-explanation (append components-in-explanation (wrap-all 'len components-in-explanation)))
;;          ;;don't use TERM to explain anything in EXPLANATION (ffixme what about subterms of term and/or explanation?)
;;          (terms-to-ignore-alist (add-value-for-each-key components-in-explanation term terms-to-ignore-alist))
;;          ;;also, if anything in EXPLANATION is forbidden to explain some term T, then so should be TERM (since TERM turns into EXPLANATION):
;;          (terms-to-ignore-alist (add-value-for-each-key-with-some-value
;;                                  term components-in-explanation
;;                                  terms-to-ignore-alist))
;;          ;;also, anything forbidden to explain TERM (stuff that turns into exprs involving TERM) should be forbidden to explain anything in explanation (because it will turn into term and thus into explanation):
;;          (terms-to-ignore-for-term (lookup-equal term terms-to-ignore-alist))
;;          (terms-to-ignore-alist (add-values-for-each-key components-in-explanation
;;                                                          terms-to-ignore-for-term
;;                                                          terms-to-ignore-alist)))
;;     (progn$ (cw "(new terms-to-ignore-alist:~%")
;;             (print-list terms-to-ignore-alist)
;;             (cw ")~%")
;;             terms-to-ignore-alist)))


;unlike try-to-express-target-tree-with-any-value this one doesn't separate the targets and values
;walks down term-traces-alist, trying to explain each term
;if an entire term cannot be explained, this tries to explain the pieces
;the pieces are allowed to explain each other
;; Returns (mv claims explanation-graph)
;it is okay for a key in term-traces-alist to also appear in whole-term-traces-alist (this function clears out that key when appropriate, so that a term isn't used to explain itself)
(skip-proofs
 (defun try-to-explain-terms-aux (term-traces-alist ;the terms are nth nests around formals
                                  whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
   (if (endp term-traces-alist)
       (mv claims-acc explanation-graph)
     (let* ((entry (car term-traces-alist))
            (term (car entry)))
       (if (member-eq term components-not-to-try-to-explain)
           (try-to-explain-terms-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
         (let* ((traces (cdr entry))
                ;; we don't allow term to explain itself: ;fixme could we use the ignore-alist for this? ;fixme what about subterms?
                (whole-term-traces-alist-without-term (remove-assoc-equal term whole-term-traces-alist))
                (explanation (try-to-express-whole-target-with-any-candidate term
                                                                             traces
                                                                             whole-term-traces-alist-without-term
                                                                             (get-terms-to-ignore term explanation-graph)
                                                                             formal-to-old-var-alist unchanged-components)))
           (if explanation
               (progn$ (cw "(Can explain ~x0 as ~x1.)~%" term explanation)
                       (let ((explanation-graph (update-explanation-graph term explanation explanation-graph)))
                         ;;recur on the rest of the terms:
                         (try-to-explain-terms-aux (cdr term-traces-alist)
                                                   whole-term-traces-alist
                                                   (cons `(equal ,term ,explanation) claims-acc)
                                                   ;;don't use TERM later to explain EXPLANATION (or any component of EXPLANATION?):
                                                   explanation-graph
                                                   formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)))
             ;;we can't explain the whole TERM, so try to explain the pieces (if the values are all lists of the same length):
             (if (not (nil-or-consp-list-list traces))
                 ;;the values for TERM don't all look like lists, so don't try to examine the pieces
                 (try-to-explain-terms-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
               (let* ((value (find-a-val-in-traces traces))
                      (len (len value)))
                 (if (not (len-equal-list-list traces len))
                     (try-to-explain-terms-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
;fffixme put this back, but we got loops!
                   ;;                  ;;the values are not all the same length, so don't examine the pieces:
                   ;;                  ;do try to explain the length:
                   ;;                  (let* ((len-term `(len ,term))
                   ;;                         (length-traces (len-list-list traces))
                   ;;                         ;;don't use term to explain its own length: ffixme what about a component of term???
                   ;;                         (length-explanation (try-to-express-whole-target-with-any-candidate
                   ;;                                              len-term
                   ;;                                              ; 5 ;ffixme do we want 0 or 1? or no bound?
                   ;;                                              length-traces
                   ;;                                              whole-term-traces-alist-without-term
                   ;;                                              explanation-graph))
                   ;;                         (explanation-graph (if length-explanation
                   ;;                                                    ;;is this needed? why would it not be?
                   ;;                                                    (add-terms-to-ignore `(len ,term) length-explanation explanation-graph)
                   ;;                                                  explanation-graph))
                   ;;                         (claims-acc (if length-explanation
                   ;;                                         (prog2$ (cw "Can explain ~x0 as ~x1.~%" len-term length-explanation)
                   ;;                                                 (cons `(equal ,len-term ,length-explanation) claims-acc))
                   ;;                                       claims-acc)))
                   ;;                    (try-to-explain-terms-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph))
                   (if (and (not (< len 32)) ;ffixme avoids diving into long arrays
                            (integer-listp value))
                       ;;the length is >= 32, so don't examine the pieces:
                       (try-to-explain-terms-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
                     ;;how slow is this?
                     (let* ((component-terms (make-nth-terms len term))
                            (component-traces (get-nths-from-traces len traces))
                            (component-term-traces-alist (pairlis$ component-terms component-traces)))
                       (mv-let (claims-acc explanation-graph)
                               (try-to-explain-terms-aux component-term-traces-alist
                                                         ;;(the entry for each component will be knocked out in the recursive
                                                         ;;call for that component) - what about subcomponents?
                                                         ;;ffixme what about using a subcomponent of one component to explain a different component (or subcomponent)?
                                                         (append component-term-traces-alist
                                                                 ;;don't use term to explain one of its components:
                                                                 whole-term-traces-alist-without-term)
                                                         claims-acc
                                                         explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components)
                               (try-to-explain-terms-aux (cdr term-traces-alist)
                                                         whole-term-traces-alist
                                                         claims-acc
                                                         explanation-graph formal-to-old-var-alist components-not-to-try-to-explain unchanged-components))))))))))))))

;; ;tries to explain each key in TERM-TRACES-ALIST in terms of other keys in the alist
;; ;this can explain one component of a key with another component of the same key
;; ;avoids creating circular explanations
;; ;returns a list of claims
;; ;if an entire term cannot be explained, this tries to explain the pieces (and the length?)
;; (defun try-to-explain-terms (term-traces-alist ;the terms are formals
;;                              )
;;   (mv-let (claims explanation-graph)
;;           (try-to-explain-terms-aux term-traces-alist term-traces-alist
;;                                     nil ; claims-acc
;;                                     nil ; explanation-graph
;;                                     )
;;           (declare (ignore explanation-graph))
;;           claims))


(defun try-to-explain-terms2 (term-traces-alist ;the terms are formals
                              components-not-to-try-to-explain
                              formal-to-old-var-alist unchanged-components)
  (progn$
   (cw "(Trying to explain terms")
   (if components-not-to-try-to-explain
       (cw "(refraining from explaining ~x0):~%" components-not-to-try-to-explain) ;fixme maybe we never refrain?  if so, take this out?
     (cw "(not refraining from explaining anything):~%"))
   (mv-let (claims explanation-graph)
           (try-to-explain-terms-aux term-traces-alist
                                     term-traces-alist
                                     nil   ; claims-acc
                                     (empty-explanation-graph) ; explanation-graph
                                     formal-to-old-var-alist
                                     components-not-to-try-to-explain unchanged-components)
           (prog2$ (cw "Done trying to explain terms.)~%")
                   (list claims explanation-graph)))))

(skip-proofs
 ;;returns (mv claims explanation-graph)
 (defun try-to-explain-lengths-aux (term-traces-alist ;the terms are nth nests around formals?
                                    whole-term-traces-alist
                                    claims-acc explanation-graph formal-to-old-var-alist unchanged-components)
   (if (endp term-traces-alist)
       (mv claims-acc explanation-graph)
     (let* ((entry (car term-traces-alist))
            (term (car entry))
            (traces (cdr entry)))
       (if (not (nil-or-consp-list-list traces))
           ;;the values for TERM don't all look like lists:
           (try-to-explain-lengths-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist unchanged-components)
         (let* ((value (find-a-val-in-traces traces))
                (len (len value)))
           (if (len-equal-list-list traces len)
               ;;don't try to explain the lengths (they are all the same), but do consider the pieces:
               (let* ((component-terms (make-nth-terms len term))
                      (component-traces (get-nths-from-traces len traces))
                      (component-term-traces-alist (pairlis$ component-terms component-traces)))
                 (mv-let (claims-acc explanation-graph)
                         (try-to-explain-lengths-aux component-term-traces-alist
                                                     ;;(the entry for each component will be knocked out in the recursive
                                                     ;;call for that component) - what about subcomponents?
                                                     ;;ffixme what about using a subcomponent of one component to explain a different component (or subcomponent)?
                                                     (append component-term-traces-alist
                                                             ;;don't use term to explain one of its components:
                                                             (remove-assoc-equal term whole-term-traces-alist) ;whole-term-traces-alist-without-term
                                                             )
                                                     claims-acc
                                                     explanation-graph formal-to-old-var-alist unchanged-components)
                         (try-to-explain-lengths-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist unchanged-components)))
             ;;the values are not all the same length:
             (b* ((length-term `(len ,term))
                  (length-traces (len-list-list traces))
                  ;;don't use term to explain its own length: ffixme what about a component of term???
                  (length-explanation (try-to-express-whole-target-with-any-candidate length-term length-traces
                                                                                      (remove-assoc-equal term whole-term-traces-alist) ;;whole-term-traces-alist-without-term (consider not clearing?)
                                                                                      (get-terms-to-ignore length-term explanation-graph) ;(lookup-equal length-term terms-to-ignore-alist)
                                                                                      formal-to-old-var-alist unchanged-components))
                  (- (and length-explanation (cw "(Can explain ~x0 as ~x1.)~%" length-term length-explanation)))
                  (explanation-graph (if length-explanation
                                         ;;is this needed? why would it not be?
                                         (update-explanation-graph length-term length-explanation explanation-graph) ;(add-terms-to-ignore `(len ,term) length-explanation terms-to-ignore-alist)
                                       explanation-graph))
                  (claims-acc (if length-explanation
                                  (cons `(equal ,length-term ,length-explanation) claims-acc)
                                claims-acc)))
               (try-to-explain-lengths-aux (cdr term-traces-alist) whole-term-traces-alist claims-acc explanation-graph formal-to-old-var-alist unchanged-components)))))))))

;returns (list claims explanation-graph)
(defun try-to-explain-lengths (term-traces-alist ;the terms are nth nests around formals?
                               explanation-graph formal-to-old-var-alist unchanged-components)
  (prog2$
   (cw "(Trying to explain lengths:~%")
   (mv-let (claims explanation-graph)
           (try-to-explain-lengths-aux term-traces-alist term-traces-alist nil explanation-graph formal-to-old-var-alist unchanged-components)
           (prog2$ (cw "Done explaining lengths.)~%")
                   (list claims explanation-graph)))))

;; ;deprecate?
;; ;returns a list of hyps over the args
;; ;fixme do we still need to deal with the depth?
;; ;the depth we should use here depends on whether we have a spec function (several params) or a generated function (one param that's a tuple)
;; ;fixme make sure this is called on the "real" args, not the single tuple arg?
;; (defun try-to-find-hyps (args-traces ;need to separate these out by formal
;;                          formal-count formals fn)
;;   (let* ((individual-arg-traces (get-nths-from-traces formal-count args-traces)) ;inefficient?
;;          (formal-traces-alist (pairlis$ formals individual-arg-traces))
;;          (dummy1 (cw ",,Finding hyps for ~x0.~%" (cons fn formals)))
;;          ;;I suppose a type fact is a fact about a single argument, not connecting two arguments:
;;          (type-facts (try-to-find-type-facts-for-term-lst 0
;;                                                              ;;a bit of a hack:
;;                                                              ;;if the function is unary, we assume that the "real" params
;;                                                              ;;are the components of the single param
;;                                                              ;;(if (equal 1 formal-count) 1 0)
;;                                                              nil ;5 ;;fffixme this is a big hack to turn this off!
;;                                                              individual-arg-traces
;;                                                              formals
;;                                                              nil))
;;          (dummy2 (cw ",,(Type facts:~%~x0)~%" type-facts))
;;          ;;is this better than the try-to-express-target-tree functions?
;;          (hyps (try-to-find-bound-hyps-for-terms ..formal-traces-alist formal-traces-alist)) ;fixme generalize this to other predicates than bounds?
;;          (dummy3 (cw ",,(Bound hyps:~%~x0)~%" hyps))
;;          (explanations (try-to-explain-terms formal-traces-alist)) ;fixme do this first?
;;          (dummy4 (cw ",,Explanations of args with other args:~%~x0~%" explanations))
;;          )
;;     (declare (ignore dummy1 dummy2 dummy3 dummy4))
;;     (append type-facts
;;             hyps
;;             explanations)))

;fffixme compare to pair-terms-with-constants
;this one does not include unchanged lengths and does not restrict itself to integers.  also, it doesn't make an alist
(skip-proofs
 (mutual-recursion
  ;;returns a list of unchanged components
  (defun find-unchanged-components-aux (term traces)
    (declare (xargs :measure 1)) ;;ffixme
    (if (all-all-same traces)
        (list term)                 ;the entire term is unchanged
      (let* ((trace (first traces)) ;fixme what if the first trace is empty? or atypical?
             (value (first trace)))
        ;;examine the components of term
        (if (and (consp value)
                 (or (< (len value) 32)
                     (not (integer-listp value)))
                 (len-equal-list-list traces (len value)))
            ;;term represents a short list, always of the same length:
            ;;recur on the components of the target
            (let* ((item-terms (make-nth-terms-rev (len value) term))
                   (item-traces (get-nths-from-traces-rev (len value) traces)))
              (find-unchanged-components-aux-list item-terms item-traces))
          ;;consider diving into individual bits??
          nil))))

  ;;returns a list of unchanged components (and lengths of components??)
  (defun find-unchanged-components-aux-list (term-lst traces-lst)
    (if (endp term-lst)
        nil
      (let ((term (first term-lst))
            (traces (first traces-lst)))
        (append (find-unchanged-components-aux term traces)
                (find-unchanged-components-aux-list (rest term-lst) (rest traces-lst))))))))

;;returns a list terms, each of which is an nth nest around a formal
(defun find-unchanged-components (args-traces arg-count formals)
  (let* ((individual-arg-traces (get-nths-from-traces arg-count args-traces)) ;move this outside the function?
         )
    (find-unchanged-components-aux-list formals individual-arg-traces)))


(defun value-on-first-tuple-of-trace (term formals args-trace)
  (let* ((first-tuple (first args-trace)))
    (eval-axe-evaluator (pairlis$-fast formals first-tuple)
                         term
                         nil
                         0 ;array depth
                         )))

(defun first-values-are-all (value term args-traces formals)
  (if (endp args-traces)
      t
    (and (equal value (value-on-first-tuple-of-trace term formals (first args-traces)))
         (first-values-are-all value term (rest args-traces) formals))))

;fixme can empty traces occur?
(defun first-values-are-all-same (term args-traces formals)
  (let* ((args-trace (first args-traces))
         (value (value-on-first-tuple-of-trace term formals args-trace)))
    (first-values-are-all value term (cdr args-traces) formals)))

;fixme use these more to save analysis later?  maybe return the constant values these seem always equal to?
;fixme can empty traces occur?
(defun find-probably-constant-components (probably-unchanged-components ;we know each of these is unchanged per trace, so make sure each trace has the same first value
                                          args-traces
                                          formals
                                          acc)
  (if (endp probably-unchanged-components)
      acc
    (let ((probably-unchanged-component (first probably-unchanged-components)))
      (find-probably-constant-components (rest probably-unchanged-components)
                                         args-traces
                                         formals
                                         (if (first-values-are-all-same probably-unchanged-component args-traces formals)
                                             (cons probably-unchanged-component acc)
                                           acc)))))

;;traces is a list of traces (for a single function since there's only 1 trace-list).
;;each trace is a list of records (one for each call of the function during the trace), each of which has :args and :return-value
;fixme ;maybe this should take a term representing the function call and generate a list of equalities expressing components of it as functions of the params? -doesn't it?

;; ;deprecate?
;; ;if this fails to express the RV as a function of the params, then it should try to generate a type fact??
;; ;arg-count is the length of arg-terms
;; ;returns (list explanation-graph explanations)
;; (defun try-to-express-rv-with-params (return-value-traces args-traces return-value-term arg-count arg-terms formal-to-old-var-alist unchanged-components)
;;   (let* ( ;(return-value-traces (g-list-list :return-value traces)) ;g-list-list may be slow?
;;          ;;(args-traces (g-list-list :args traces))
;;          ;;can we combine the get-nths-from-traces and the g-list-list for speed?
;;          (args-traces-alist (pairlis$ arg-terms (get-nths-from-traces arg-count args-traces))))
;;     (mv-let (explanation-graph explanations)
;;             (try-to-express-target-tree-with-any-value return-value-term
;;                                                        return-value-traces
;;                                                        args-traces-alist formal-to-old-var-alist unchanged-components nil)
;;             (list explanation-graph explanations))))

;explans is all explanations of values in terms of targets
;returns (list explanation-graph explanations)
(defun try-to-express-params-with-params (args-traces1 arg-count1 formals1 args-traces2 arg-count2 formals2 formal-to-old-var-alist unchanged-components explanation-graph explans)
  (let* ((value-traces-alist (pairlis$ formals2
                                         (get-nths-from-traces arg-count2 args-traces2))))
    (mv-let (explanation-graph explanations)
            (try-to-express-target-tree-list-with-any-value (get-nths-from-traces arg-count1 args-traces1)
                                                            formals1
                                                            value-traces-alist formal-to-old-var-alist unchanged-components
                                                            explanation-graph
                                                            explans
                                                            nil)
            (list explanation-graph explanations))))

;; ;deprecated?
;; (defun try-to-express-rv-with-rvs-and-params (rv1-term traces1 rv2-term traces2 arg-count2 formals2 formal-to-old-var-alist unchanged-components)
;;   (let* ((return-value-traces1 (g-list-list :return-value traces1))
;;          (return-value-traces2 (g-list-list :return-value traces2))
;;          (args-traces2 (g-list-list :args traces2))
;;          ;;we put the params before the return values, because using them is better (when possible)
;;          (value-traces-alist (pairlis$ (append formals2 (list rv2-term))
;;                                          (append (get-nths-from-traces arg-count2 args-traces2) (list return-value-traces2))
;;                                          )))
;;     (try-to-express-target-tree-with-any-value rv1-term
;;                                                return-value-traces1
;;                                                value-traces-alist formal-to-old-var-alist unchanged-components)))

;; (defun make-type-facts-for-rv (return-value-traces equated-term)
;;   (try-to-find-type-facts-for-term 0 ;fixme or should we use 1?
;;                                       nil ;fake param-depth
;;                                       return-value-traces
;;                                       equated-term nil))


;; (mutual-recursion
;;  (defun remove-hides (term)
;;    (if (variablep term)
;;        term
;;      (if (fquotep term)
;;          term
;;        (let ((fn (ffn-symb term)))
;;          (if (equal 'hide fn)
;;              (remove-hides (second term))
;;            ;;handle lambdas?  fixme
;;            (cons fn (remove-hides-lst (fargs term))))))))

;;  (defun remove-hides-lst (term-lst)
;;    (if (endp term-lst)
;;        nil
;;      (cons (remove-hides (first term-lst))
;;            (remove-hides-lst (cdr term-lst))))))

;; (mutual-recursion
;;  (defun introduce-hides (terms-to-hide term)
;;    (if (member-equal term terms-to-hide)
;;        `(hide ,term)
;;      (if (variablep term)
;;          term
;;        (if (fquotep term)
;;            term
;;          (let ((fn (ffn-symb term)))
;;            ;;handle lambdas?  fixme
;;            (cons fn (introduce-hides-lst terms-to-hide (fargs term))))))))

;;  (defun introduce-hides-lst (terms-to-hide term-lst)
;;    (if (endp term-lst)
;;        nil
;;      (cons (introduce-hides terms-to-hide (first term-lst))
;;            (introduce-hides-lst terms-to-hide (cdr term-lst))))))

(in-theory (disable smaller-termp))

;yikes! this may have caused problems because (equal <term> <constant>) got reversed by this function
;reversing the orientation of equalities
;what was the point of this, to drop one of (equal a b) and (equal b a) when we have both?
(defun standardize-equalities (hyps)
  (declare (xargs :guard (pseudo-term-listp hyps)))
  (if (endp hyps)
      nil
    (let ((hyp (car hyps)))
      (cons (if (call-of 'equal hyp)
                (if (smaller-termp (second hyp) (third hyp))
                    `(equal ,(third hyp) ,(second hyp)) ;reverse of what we had before
                  `(equal ,(second hyp) ,(third hyp)))
              hyp)
            (standardize-equalities (cdr hyps))))))

;; ;keep items of the form (.. (nth '<constant> <some-formal>) ..)
;; ;so this throws away explanations of subterms?  don't bother to compute them then?!  better yet, find a way to use them...
;; (defun filter-explanations (explanations formals)
;;   (if (endp explanations)
;;       nil
;;     (let* ((explanation (car explanations))
;;            (lhs (second explanation)))
;;       (if (and (consp lhs)
;;                (equal 'nth (ffn-symb lhs))
;;                (quotep (first (fargs lhs)))
;;                (member-eq (second (fargs lhs)) formals))
;;           (cons explanation (filter-explanations (cdr explanations) formals))
;;         (filter-explanations (cdr explanations) formals)))))


;; ;separates out the explanations that are about lengths
;; ;; Returns (list length-explanations formal-or-component-explanations)
;; (defun filter-explanations (explanations length-explanations-acc formal-or-component-explanations-acc)
;;   (if (endp explanations)
;;       (list length-explanations-acc formal-or-component-explanations-acc)
;;     (let* ((explanation (first explanations)) ;should be an equality
;;            (lhs (farg1 explanation)))
;;       (if (call-of 'len lhs)
;;           (filter-explanations (rest explanations) (cons explanation length-explanations-acc) formal-or-component-explanations-acc)
;;         (filter-explanations (rest explanations) length-explanations-acc (cons explanation formal-or-component-explanations-acc))))))

;checks that the annotations only mention the formals (any old vars should just be formals wrapped in oldval)
(defun syntax-okay-for-annotationsp (fn annotations key formals)
  (let ((vars-appearing (get-vars-from-terms annotations)))
    (if (subsetp-eq vars-appearing formals) ;fixme improve the messages to say which vars are bad. also mention fn-name
        t
      (hard-error 'syntax-okay-for-annotationsp "The ~x0 entry for ~x1 mentions vars: ~x2, but the formals are: ~x3 (BTW, old variables should be wrapped in calls of oldval)."
                  (acons #\0 key
                         (acons #\1 fn
                                (acons #\2 vars-appearing
                                       (acons #\3 formals nil))))))))

;; old vars are not allowed in these (it's not clear how old var names will be generated in the event of name clashes).  instead, the user should call oldval
;fixme these should be checks that prove-with-axe can't do (e.g., because the functions may not be defined, prove-with-axe doesn't know what their formals are)
;; fixme check the form of the user-supplied explanations - must be equalities whose lhses are nth nests around formals? what about "explanations" of lengths?
;fixme think about (oldval (len x)) vs (len (old x))... we now require the argument to oldval to be a formal - check that here!
;besides checking the vars, fixme what other checks should we do?  any other components of extra stuff to check?  some may be checked by prove-with-axe?
;perhaps an error if something appears in both the extra and remove lists..
;fixme check arities?
(defun check-annotations (fn extra-hyps remove-hyps explanations explanations-to-remove formals)
  (and (syntax-okay-for-annotationsp fn extra-hyps :extra-hyps formals)
       (syntax-okay-for-annotationsp fn remove-hyps :remove-hyps formals)
       (syntax-okay-for-annotationsp fn explanations :explanations formals)
       (syntax-okay-for-annotationsp fn explanations-to-remove :explanations-to-remove formals)))

;BOZO remove lemma collecting code from this version of the file (mostly done?)  or collect lemmas somehow to save time!


;; ;deprecate this?
;; ;ffixme what if x involves printing - shouldn't that stuff be printed before the close paren? maybe not, the way this is used..
;; (defmacro cparen (x)
;;   `(prog2$ (if (member-eq print '(t :verbose)) (cw ")~%") nil)
;;            ,x))

;this version does not cut the lemmas, but instead calls stp on the whole things - no longer true?!

;; (defun safe-min (x y)
;;   (if (not (rationalp x))
;;       (hard-error 'safe-min "Tried to call min on the non-rational ~x0." (acons #\0 x nil))
;;     (if (not (rationalp y))
;;         (hard-error 'safe-min "Tried to call min on the non-rational ~x0." (acons #\0 y nil))
;;       (min x y))))

;; (defun safe-max (x y)
;;   (if (not (rationalp x))
;;       (hard-error 'safe-max "Tried to call max on the non-rational ~x0." (acons #\0 x nil))
;;     (if (not (rationalp y))
;;         (hard-error 'safe-max "Tried to call max on the non-rational ~x0." (acons #\0 y nil))
;;       (max x y))))

;; (defun safe-max-debug (tag x y)
;;   (if (not (rationalp x))
;;       (hard-error 'safe-max-debug "Tried to call max on the non-rational ~x0. Tag: ~x1" (acons #\1 tag (acons #\0 x nil)))
;;     (if (not (rationalp y))
;;         (hard-error 'safe-max-debug "Tried to call max on the non-rational ~x0. Tag: ~x1" (acons #\1 tag (acons #\0 y nil)))
;;       (max x y))))

;; (skip- proofs (verify-guards SAFE-MAX-DEBUG))

;; (defun all-zeros-or-ones (sig)
;;   (declare (xargs :guard t))
;;   (or (atom sig)
;;       (and (or (eql 1 (car sig))
;;                (eql 0 (car sig)))
;;            (all-zeros-or-ones (cdr sig)))))


;; ;bozo think about this...
;; ;we return sets of equal nodes with the same signature
;; ;we process nodes from high nodenums (listed first) to low nodenums (listed later)
;; ;we add a set when we check the largest node in the set (thereafter we skip all members of the set)
;; (defun find-sets-of-probably-equal-nodes (signature-alist dag-array nodes-to-skip acc)
;;   (declare (xargs :guard (and (TRUE-LISTP NODES-TO-SKIP)
;;                               (true-listp acc)
;;                               (ALIST-with-integer-keysp signature-alist))

;;                   :verify-guards nil
;;                   )
;;            )
;;   (if (endp signature-alist)
;;       (reverse acc) ;is this important?
;;     (let* ((entry (car signature-alist))
;;            (nodenum (car entry)))
;;       (if (member nodenum nodes-to-skip)
;;           (find-sets-of-probably-equal-nodes (cdr signature-alist) dag-array nodes-to-skip acc)
;;         (let* ((signature (cdr entry))
;;                ;;find all matches beyond the current node (so it finds the whole set when we process the largest node in the set)
;;                (possible-matches (and ;; (all-zeros-or-ones signature) ;trying without this now...
;;                                       ;;                                   ;now we don't make correspondences between xors BBOZO
;;                                       ;;                                   (let* ((expr (aref1 'dag-array dag-array nodenum)))
;;                                       ;;                                     (or (not (consp expr))
;;                                       ;;                                         (not (equal 'bitxor (car expr)))))
;;                                   (all-natp signature)
;;                                   (find-nodes-for-term ;bad name for this use
;;                                        signature
;;                                        (cdr signature-alist))))
;;                )
;;           (if (and possible-matches
;;                    ;;BOZO allow the user to pass is disallowed fns?
;;                    (none-are-nodenums-of-disallowed-fns possible-matches '(bvif) dag-array)
;;                    )
;;               (find-sets-of-probably-equal-nodes
;;                (cdr signature-alist)
;;                dag-array
;;                (cons nodenum (append possible-matches nodes-to-skip))
;;                (cons (cons nodenum possible-matches) acc)
;;                )
;;             (find-sets-of-probably-equal-nodes (cdr signature-alist) dag-array nodes-to-skip acc)))))))

;(skip- proofs (verify-guards find-sets-of-probably-equal-nodes))

(defun sig-<-aux (sig1 sig2)
  (declare (xargs :guard t))
  (if (atom sig1)
      (if (atom sig2)
          nil
        (hard-error 'sig-<-aux "Sigs should be the same length, but we have ~x0 and ~x1" (acons #\0 sig1 (acons #\1 sig2 nil))))
    (if (consp sig2) ;sig1 is a consp, so sig2 must be as well
        (let* ((car1 (car sig1))
               (car2 (car sig2)))
          (if (equal car1 car2)
              (sig-<-aux (cdr sig1) (cdr sig2))
            (if (lexorder car1 car2)
                t
              nil)))
      (hard-error 'sig-<-aux "Sigs should be the same length, but we have ~x0 and ~x1" (acons #\0 sig1 (acons #\1 sig2 nil))))))

(defun sig-< (entry1 entry2)
  (declare (xargs :guard (and (consp entry1) (consp entry2))))
  (prog2$ nil ;(cw "Comparing sigs ~x0 and ~x1~%" (car entry1) (car entry2)) ;BBOZO remove
          (sig-<-aux (cdr entry1) (cdr entry2))))

;; (defun merge-sig-< (l1 l2 acc)
;;   (declare (xargs :guard (and (true-listp l1)
;;                               (true-listp l2)
;;                               (true-listp acc))
;;                   :verify-guards nil
;;                   :measure (+ (len l1) (len l2))))
;;   (cond ((endp l1)
;;          (revappend acc l2))
;;         ((endp l2) (revappend acc l1))
;;         ((sig-< (car l1) (car l2))
;;          (merge-sig-< (cdr l1)
;;                       l2 (cons (car l1) acc)))
;;         (t (merge-sig-< l1 (cdr l2)
;;                         (cons (car l2) acc)))))

;; (skip- proofs (verify-guards merge-sig-<))



;; ;fffixme use my new fast merge-sort (make sure it is faster)
;; (defun merge-sort-sig-< (l)
;;   (declare (xargs :guard (true-listp l)
;;                   :verify-guards nil
;;                   :measure (len l)
;;                   :hints (("Goal" :use ((:instance len-of-evens-tail-bound (acc nil))
;;                                         (:instance len-of-evens-tail-bound (l (cdr l)) (acc nil)))
;;                            :expand (
;;                                    ; (EVENS-TAIL (CONS L1 L2) NIL)
;;                                     )
;;                            :in-theory (disable len-of-evens-tail-bound)))
;;                   ))
;;   (cond ((endp (cdr l)) l)
;;         (t (merge-sig-< (merge-sort-sig-< (evens-tail l nil))
;;                         (merge-sort-sig-< (odds-tail l))
;;                         nil
;;                         ))))

;; (skip- proofs (verify-guards merge-sort-sig-<))





;;
;; deciding which nodes to translate to STP (and which nodes to not translate, i.e., to cut)
;;

;this allows the exprs (and the nodes the refer to) to differ on whether constants are inlined (because when we replace a probably-constant node, we don't inline it)
;i think this allows for non-unique representation of expressions..
;;; TODO: what about deeper structural equivalence - all leaf nodes the same and all operator nodes corresponding? - better to merge up the dag aggressively at merge time?
;; (skip-proofs
;;   (mutual-recursion
;;     (defun identical-darg-lists-up-to-constant-inlining (dargs1 dargs2 dag-array-name dag-array dag-len)
;;       (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
;;                                   (bounded-darg-listp dargs1 dag-len)
;;                                   (bounded-darg-listp dargs2 dag-len))))
;;       (if (endp dargs1)
;;           (if (endp dargs2)
;;               t
;;             (er hard? 'identical-darg-lists-up-to-constant-inlining "args lists not the same length" nil))
;;         (if (endp dargs2)
;;             (er hard? 'identical-darg-lists-up-to-constant-inlining "args lists not the same length" nil)
;;           (and
;;             (let* ((darg1 (first dargs1))
;;                    (darg2 (first dargs2)))
;;               (if (quotep darg1)
;;                   (if (quotep darg2)
;;                       (equal darg1 darg2)
;;                     ;; darg2 may be a nodenum of a constant:
;;                     (equal darg1 (aref1 dag-array-name dag-array darg2)))
;;                 (if (quotep darg2)
;;                     ;; darg1 may be a nodenum of a constant:
;;                     (equal darg2 (aref1 dag-array-name dag-array darg1))
;;                   ;;two nodenums:
;;                   (or (equal darg1 darg2) ;this optimization should catch a lot of the cases where things actually are the same
;;                       (identical-dag-exprs-up-to-constant-inlining (aref1 dag-array-name dag-array darg1)
;;                                                                    (aref1 dag-array-name dag-array darg2)
;;                                                                    dag-array-name dag-array dag-len)))))
;;             (identical-darg-lists-up-to-constant-inlining (rest dargs1) (rest dargs2) dag-array-name dag-array dag-len)))))

;;     ;;we could relax this even more and not require nodenums to be unique either... what if we have (foo (bar '2)) both with and without the inlined 2?
;;     (defun identical-dag-exprs-up-to-constant-inlining (expr1 expr2 dag-array-name dag-array dag-len)
;;       (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
;;                                   (bounded-dag-exprp dag-len expr1)
;;                                   (bounded-dag-exprp dag-len expr2))))
;;       (if (or (symbolp expr1)
;;               (symbolp expr2)
;;               (quotep expr1)
;;               (quotep expr2))
;;           (equal expr1 expr2)
;;         ;;function call:
;;         (and (eq (ffn-symb expr1) (ffn-symb expr2))
;;              (identical-darg-lists-up-to-constant-inlining (dargs expr1) (dargs expr2) dag-array-name dag-array dag-len))))))

(defun identical-darg-lists-up-to-constant-inlining (dargs1 dargs2 dag-array-name dag-array dag-len)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (bounded-darg-listp dargs1 dag-len)
                              (bounded-darg-listp dargs2 dag-len))))
  (if (endp dargs1)
      (if (endp dargs2)
          t
        (er hard? 'identical-darg-lists-up-to-constant-inlining "args lists not the same length"))
    (if (endp dargs2)
        (er hard? 'identical-darg-lists-up-to-constant-inlining "args lists not the same length")
      (and (let* ((darg1 (first dargs1))
                  (darg2 (first dargs2)))
             (if (quotep darg1)
                 (if (quotep darg2)
                     (equal darg1 darg2)
                   ;; darg2 may be a nodenum of a constant:
                   (equal darg1 (aref1 dag-array-name dag-array darg2)))
               (if (quotep darg2)
                   ;; darg1 may be a nodenum of a constant:
                   (equal darg2 (aref1 dag-array-name dag-array darg1))
                 ;;two nodenums:
                 (equal darg1 darg2))))
           (identical-darg-lists-up-to-constant-inlining (rest dargs1) (rest dargs2) dag-array-name dag-array dag-len)))))

(defund identical-dag-exprs-up-to-constant-inlining (expr1 expr2 dag-array-name dag-array dag-len)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (bounded-dag-exprp dag-len expr1)
                              (bounded-dag-exprp dag-len expr2))
                  :guard-hints (("Goal" :in-theory (e/d (bounded-dag-exprp dag-exprp dag-function-call-exprp)
                                                        (dag-function-call-exprp-redef))))))
  (if (or (variablep expr1)
          (variablep expr2))
      nil ; won't be 2 nodes with the same var
    (let ((fn1 (ffn-symb expr1))
          (fn2 (ffn-symb expr2)))
      (if (or (eq 'quote fn1)
              (eq 'quote fn2))
          (equal (unquote expr1) (unquote expr2))
        ;; both are function calls:
        (and (eq fn1 fn2)
             (let ((dargs1 (dargs expr1))
                   (dargs2 (dargs expr2)))
               (identical-darg-lists-up-to-constant-inlining dargs1 dargs2 dag-array-name dag-array dag-len)))))))


;; (defun clean-up-hyps (hyps)
;;   (declare (xargs :guard (pseudo-term-listp hyps)))
;;   (let* ((hyps (standardize-equalities hyps))
;;          (hyps (remove-duplicates-equal hyps)))
;;     hyps))

;; ;;returns (mv failedp state) where failedp means the proof failed or there was some sort of other error (e.g., an unknown function)
;; (defun my-defthm-fn2 (name hyps concs hints elide-hintsp rule-classes print state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (let* ((body `(implies ,(make-conjunction-from-list (clean-up-hyps hyps))
;;                          ,(make-conjunction-from-list concs)))
;;          (event `(defthm ,name ,body :rule-classes ,rule-classes :hints ,hints))
;;          (event-no-hints (if elide-hintsp
;;                              `(defthm ,name ,body :rule-classes ,rule-classes :hints :elided)
;;                            event)))
;;     (prog2$ (and print (cw "(Attempting to prove:~%~x0." event-no-hints))
;;             (mv-let (erp result state)
;;               (defthm-fn name body state rule-classes nil
;;                 hints nil event)
;;               (prog2$ (and print (cw "~x0)~%" result))
;;                       (let ((state (if (equal '(:rewrite) rule-classes)
;;                                        state ;(populate-tables-with-claims concs state) ;newly removed
;;                                      state)))
;;                         (mv erp state)))))))

;; ;;returns (mv failedp state) where failedp means the proof failed or there was some sort of other error (e.g., an unknown function)
;; (defun my-defthm-fn-rewrite (name hyps concs hints elide-hintsp state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (my-defthm-fn2 name hyps concs hints elide-hintsp '(:rewrite) t ;fixme
;;                  state))

;; ;;returns (mv failedp state) where failedp means the proof failed or there was some sort of other error (e.g., an unknown function)
;; ;use this more! or use submit-event?
;; (defmacro my-defthm (name hyps concs
;;                           &key
;;                           (rule-classes ''(:rewrite))
;;                           (hints 'nil)
;;                           (elide-hintsp 't)
;;                           (print 't))
;;   `(my-defthm-fn2 ,name ,hyps ,concs ,hints ,elide-hintsp ,rule-classes ,print state))

;; ;;returns (mv failedp state) where failedp means the proof failed or there was some sort of other error (e.g., an unknown function)
;; (defun my-defthm-fn-rewrite-or-nil (name hyps concs hints rule-class state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (eq :nil rule-class)
;;       (my-defthm-fn2 name hyps concs hints t nil t ;fixme
;;                      state)
;;     (if (eq :rewrite rule-class)
;;         (my-defthm-fn-rewrite name hyps concs hints t state)
;;       (mv (prog2$ (hard-error 'my-defthm-fn-rewrite-or-nil "Unkwown rule class." nil)
;;                   t)
;;           state))))


;;returns (mv erp state)
;meaning of the return values?
;does not make it a rewrite rule!
;; (defun my-defthm-fn (name hyps concs hints elide-hintsp state)
;;   (declare (xargs :mode :program))
;;   (let* ((body `(implies ,(make-conjunction-from-list (clean-up-hyps hyps))
;;                          ,(make-conjunction-from-list concs)))
;;          (event `(defthm ,name ,body :rule-classes nil :hints ,hints))
;;          (event-no-hints (if elide-hintsp
;;                              `(defthm ,name ,body :rule-classes nil :hints :elided)
;;                            event)))
;;     (prog2$ nil ;(cw "USB tables: ~x0~%~x1~%" (f-get-global 'usb-table state) (f-get-global 'usb-list-table state))
;;             (prog2$ (cw "(Attempting to prove:~%~x0." event-no-hints)
;;                     (mv-let (erp result state)
;;                             (defthm-fn name body state nil nil hints nil event)
;;                             (prog2$ (cw "~x0)~%" result)
;;                                     (mv erp state)))))))


;; ;;first proves the theorem with the hides, then removes them from the hyps and concs
;; ;;returns (mv erp state)
;; (defun my-defthm-fn-rewrite-with-and-without-hides (terms-to-hide name hyps concs hints state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (let ((name-with-hides (pack$ name '-with-hides))
;;         (concs (introduce-hides-lst terms-to-hide concs)))
;;     (mv-let (erp state)
;;             ;;not a rewrite rule:
;;             (my-defthm-fn2 name-with-hides hyps concs hints t nil t ;fixme
;;                            state)
;;             (if erp
;;                 (mv t state)
;;               (let ((hyps (remove-hides-lst hyps))
;;                     (concs (remove-hides-lst concs)))
;;                 (my-defthm name hyps concs
;;                            :hints
;;                            `(("Goal" :do-not '(generalize eliminate-destructors)
;;                               :in-theory (theory 'minimal-theory)
;;                               :expand ((:free (x) (hide x)))
;;                               :use (:instance ,name-with-hides)))
;;                            :elide-hintsp nil))))))

;; (defun fact-is-about-item (fact item)
;;   (subtree item fact))

;; (defun fact-is-about-any-item (fact items)
;;   (if (endp items)
;;       nil
;;     (if (fact-is-about-item fact (car items))
;;         t
;;       (fact-is-about-any-item fact (cdr items)))))

;; (defun keep-facts-not-about-items (facts items)
;;   (if (endp facts)
;;       nil
;;     (if (not (fact-is-about-any-item (car facts) items))
;;         (cons (car facts)
;;               (keep-facts-not-about-items (cdr facts) items))
;;       (keep-facts-not-about-items (cdr facts) items))))

;; (defun conclusion-conjuncts (rv-type-facts possible-rv-equalities)
;;   (let* ((equated-items (STRIP-CADRS possible-rv-equalities))
;;          (rv-type-facts (keep-facts-not-about-items rv-type-facts equated-items)))
;;     (append rv-type-facts possible-rv-equalities)))

;; ;this can change nodenums
;; (defun dag-array-to-dag-lst (dag-array dag-len)
;;   (drop-non-supporters-array-with-name 'dag-array ;fixme?
;;                              dag-array ;dag-len
;;                              (+ -1 dag-len) nil))

;ffffixme should this drop non supporters?
(defun dag-array-to-dag-lst2-aux (dag-array-name dag-array nodenum acc)
  (declare (xargs :measure (nfix (+ 1 nodenum))))
  (if (not (natp nodenum))
      (reverse acc)
    (dag-array-to-dag-lst2-aux dag-array-name
                               dag-array
                               (+ -1 nodenum)
                               (cons (cons nodenum (aref1 dag-array-name dag-array nodenum))
                                     acc))))

;ffffixme should this drop non supporters?
;fixme use a worklist?
(defun dag-array-to-dag-lst2 (dag-array-name dag-array nodenum)
  (dag-array-to-dag-lst2-aux dag-array-name dag-array nodenum nil))

;ffffixme what if one of the items is an equality with a constant?
(defun equate-items-to-t-both-ways (items)
  (if (endp items)
      nil
    (let ((item (car items)))
      (if (call-of 'equal item)
          (cons `(equal (equal ,(second item) ,(third item)) 't)
                (cons `(equal (equal ,(third item) ,(second item)) 't)
                      (equate-items-to-t-both-ways (cdr items))))
        (cons `(equal ,item 't)
              (equate-items-to-t-both-ways (cdr items)))))))

(defun make-param-constant-alist (arg-names terms)
  (if (endp terms)
      nil
    (let ((term (car terms)))
      (if (quotep term)
          (acons-fast (car arg-names) term
                 (make-param-constant-alist (cdr arg-names) (cdr terms)))
        (make-param-constant-alist (cdr arg-names) (cdr terms))))))

;make sure this is not used
;; (defun my-defthm-fn-fake (name hyps concs hints state)
;;   (declare (ignore name hyps concs hints)
;;            (xargs :stobjs state
;;                   :verify-guards nil))
;;   (mv nil state))

(mutual-recursion
 (defun replace-nthcdr-0-in-if-nest (nest)
   (if (atom nest)
       nest
     (if (eq 'quote (car nest))
         nest
       ;; function call
       (if (and (eq 'nthcdr (ffn-symb nest))
                (equal ''0 (first (fargs nest))))
           (second (fargs nest))
         (cons (ffn-symb nest)
               (replace-nthcdr-0-in-if-nest-list (fargs nest)))))))

 (defun replace-nthcdr-0-in-if-nest-list (nest)
   (if (endp nest)
       nil
     (cons (replace-nthcdr-0-in-if-nest (car nest))
           (replace-nthcdr-0-in-if-nest-list (cdr nest))))))

;; (defun add-hides (items)
;;   (if (endp items)
;;       nil
;;     (cons `(hide ,(car items))
;;           (add-hides (cdr items)))))

(defun all-match (x y)
  (if (endp x)
      t
    (and (equal (car x) (car y))
         (all-match (cdr x) (cdr y)))))

;; ;;returns a list of hyps...
;; (defun syntaxp-hyps-for-hide-opener (formals desired-args for-axe-proverp)
;;   (list (if (not for-axe-proverp)
;;             `(syntaxp (equal ,(make-cons-nest formals) ',desired-args))
;;           `(axe-syntaxp (nodenums-are-vars ,(make-cons-nest formals) ',desired-args dag-array)))))

;; ;;returns a list of hyps...
;; (defun syntaxp-hyps-for-hide-dropper (formals desired-args for-axe-proverp)
;;   (list (if (not for-axe-proverp)
;;             `(syntaxp (not (equal ,(make-cons-nest formals) ',desired-args)))
;;           `(axe-syntaxp (nodenums-are-not-vars ,(make-cons-nest formals) ',desired-args dag-array)))))

;; ;try this!
;; (defun my-disable-fn (rune state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (let ((world (w state)))
;;     (mv-let (err result state)
;;             (in-theory-fn (SET-DIFFERENCE-CURRENT-THEORY-FN
;;                            (list rune) nil world) state nil)
;;             (declare (ignore err result))
;;             state)))

;; ;; In order to get exactly the expansions that we want, we use a trick with HIDE.
;; ;; We want to expand (foo a b c), but ACL2 may first substitute a constant for one of a/b/c, which changes the term to be expanded, so an :expand hint doesn't work.  So we wrap (foo a b c) in a hide and add rules to expand (foo a b c) when inside a hide and drop the hide when the args aren't exactly (a b c).
;; ;; Also, the axe-prover doesn't support :expand hints.

;; ;if for-axe-proverp is nil, these are put in rule-classes :nil, since I don't know how to disable them to keep them from firing during non-dag proofs -- fixme try my-disable-fn above
;; ;;returns state
;; (defun make-hide-opener-and-dropper (function-name desired-args for-axe-proverp opener-name dropper-name state)
;;   (declare (xargs :stobjs state
;;                   :mode :program
;;                   ))
;;   (let ((props (GETPROPS function-name 'CURRENT-ACL2-WORLD (W STATE))))
;;     (if (not props)
;;         (prog2$ (hard-error 'make-hide-opener-and-dropper
;;                             "Can't find a function named ~x0." (list (cons #\0 function-name)))
;;                 state)
;;       (let* ((body (lookup-eq 'unnormalized-body props))
;;              (formals (lookup-eq 'formals props))
;;              (function-call (cons function-name formals))
;;              (rule-classes (if for-axe-proverp nil '(:rewrite)))
;;              )
;;         (mv-let (erp state)
;;                 (let ((name opener-name ;(pack$ function-name '-hide-opener '- tag)
;;                             )
;;                       (hyps (syntaxp-hyps-for-hide-opener formals desired-args for-axe-proverp))
;;                       (concs (list `(equal (hide ,function-call) ,body)))
;;                       (hints `(("Goal" :expand (,function-call
;;                                                 (:free (x) (hide x)))
;;                                 :in-theory (theory 'minimal-theory)))))
;;                   ;;we remove the hide and open the function when it's being applied to
;;                   ;;all the vars that we expect
;;                   (my-defthm name
;;                              hyps
;;                              concs
;;                              :hints hints
;;                              :rule-classes rule-classes
;;                              :print nil))
;;                 (declare (ignore erp)) ;fixme
;;                 (mv-let (erp state)
;;                         ;;we open the hide but not the function when any of the args is wrong
;;                         (my-defthm
;;                          dropper-name
;;                          (syntaxp-hyps-for-hide-dropper formals desired-args for-axe-proverp)
;;                          (list `(equal (hide ,function-call) ,function-call))
;;                          :hints
;;                          `(("Goal" :expand ((:free (x) (hide x)))
;;                             :in-theory (theory 'minimal-theory)))
;;                          :rule-classes rule-classes
;;                          :print nil)
;;                         (declare (ignore erp))
;;                         state))))))



(mutual-recursion
 (defun fixup-inner-body-for-make-induction-function (expr outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)
   (declare (xargs :guard (and (pseudo-termp expr)
                               (symbol-listp outer-vars)
                               (true-listp outer-rec-call-exprs)
                               (symbolp inner-fn-name)
                               (symbolp new-fn-name))))
   (if (atom expr)
       expr
     (let ((fn (ffn-symb expr)))
       (if (eq 'quote fn)
           expr
         (if (eq fn inner-fn-name)
             `(,new-fn-name ,@outer-rec-call-exprs ,@(fargs expr))
           (let* ((args (fixup-inner-body-for-make-induction-function-list
                         (fargs expr)
                         outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)))
             (if (consp fn) ;tests for lambda
                 (let* ((formals (second fn))
                        (body (third fn))
                        (body (fixup-inner-body-for-make-induction-function body outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)))
                   (cons `(lambda ,(append formals outer-vars) ,body)
                         (append args outer-vars)))
               (cons fn args))))))))

 (defun fixup-inner-body-for-make-induction-function-list (exprs outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)
   (declare (xargs :guard (and (pseudo-term-listp exprs)
                               (symbol-listp outer-vars)
                               (true-listp outer-rec-call-exprs)
                               (symbolp inner-fn-name)
                               (symbolp new-fn-name))))
   (if (endp exprs)
       nil
     (cons (fixup-inner-body-for-make-induction-function (car exprs) outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)
           (fixup-inner-body-for-make-induction-function-list (cdr exprs) outer-vars outer-rec-call-exprs inner-fn-name new-fn-name)))))

;; processes the outer function, OUTER-FN
;; basically copies the outer function except puts in the inner function instead of the recursive call (and changes the inner function's recursive call to the call to the new, joint function)
;;returns (mv new-expr contains-recursive-callp)
(mutual-recursion
 (defun make-induction-function-aux (expr outer-fn inner-function-body inner-function-params new-fn-name inner-fn-name)
   (declare (xargs :guard (and (pseudo-termp expr)
                               (symbolp outer-fn)
                               (pseudo-termp inner-function-body)
                               (symbol-listp inner-function-params)
                               (symbolp new-fn-name)
                               (symbolp inner-fn-name))
                   :verify-guards nil ; done below
                   ))
   (if (atom expr)
       (mv expr nil)
     (let ((fn (ffn-symb expr)))
       (if (eq 'quote fn)
           (mv expr nil)
         (if (eq fn outer-fn) ;this is the recursive call
             ;;we embed the (fixed up) body of the inner function
             ;;if it contains lambdas, they will need to have vars added for any params the outer function passes into the recursive call (these will be passed into the call of the new function)
             (mv (fixup-inner-body-for-make-induction-function
                  inner-function-body
                  (get-vars-from-terms (fargs expr)) ;all vars that appear in params to the recursive call
                  (fargs expr) ;;the param values for the recursive all
                  inner-fn-name
                  new-fn-name)
                 t)
           (mv-let (arg-exprs args-contain-recursive-callp)
                   (make-induction-function-aux-list (fargs expr) outer-fn inner-function-body inner-function-params new-fn-name inner-fn-name)
                   (if (consp fn) ;tests for lambda
                       (let* ((formals (second fn))
                              (body (third fn)))
                         (mv-let (new-body body-contains-recursive-callp)
                                 (make-induction-function-aux body outer-fn inner-function-body
                                                              inner-function-params new-fn-name
                                                              inner-fn-name)
                                 ;;if the body contains a recursive call, then after fixup it will have all the params of the inner fn as free vars
                                 (mv `((lambda ,(if body-contains-recursive-callp
                                                    (append formals inner-function-params)
                                                  formals)
                                         ,new-body)
                                       ,@(if body-contains-recursive-callp
                                             (append arg-exprs inner-function-params)
                                           arg-exprs))
                                     (or args-contain-recursive-callp
                                         body-contains-recursive-callp))))
                     ;;regular function call
                     (mv (cons fn arg-exprs)
                         args-contain-recursive-callp))))))))

 (defun make-induction-function-aux-list (exprs fn inner-function-body inner-function-params new-fn-name inner-fn-name)
   (declare (xargs :guard (and (pseudo-term-listp exprs)
                               (symbolp fn)
                               (pseudo-termp inner-function-body)
                               (symbol-listp inner-function-params)
                               (symbolp new-fn-name)
                               (symbolp inner-fn-name))))
   (if (endp exprs)
       (mv nil nil)
     (mv-let (new-expr contains-recursive-callp)
             (make-induction-function-aux (car exprs) fn inner-function-body inner-function-params new-fn-name inner-fn-name)
             (mv-let (new-exprs contains-recursive-callp-cdr)
                     (make-induction-function-aux-list (cdr exprs) fn inner-function-body inner-function-params new-fn-name inner-fn-name)
                     (mv (cons new-expr new-exprs)
                         (or contains-recursive-callp
                             contains-recursive-callp-cdr)))))))

(local
 (defthm true-listp-of-mv-nth-0-of-make-induction-function-aux-list
     (true-listp (mv-nth 0 (make-induction-function-aux-list exprs fn inner-function-body inner-function-params new-fn-name inner-fn-name)))
   :hints (("Goal" :induct (len exprs)
                   :in-theory (enable (:i len))))))

(verify-guards make-induction-function-aux)

(defun make-induction-function-helper (fn1 formals1 body1 fn2 formals2 body2 induction-fn-name)
  (declare (xargs :guard (and (symbolp fn1)
                              (symbol-listp formals1)
                              (pseudo-termp body1)
                              (symbolp fn2)
                              (symbol-listp formals2)
                              (pseudo-termp body2)
                              (symbolp induction-fn-name))))
  (let* ((arity1 (len formals1))
         (arity2 (len formals2))
         (new-formals1 (make-var-names 'farg arity1))
         (new-formals2 (make-var-names 'garg arity2))
         (body1 (sublis-var-simple (pairlis$ formals1 new-formals1) body1))
         (body2 (sublis-var-simple (pairlis$ formals2 new-formals2) body2))
         ;;ffixme this stuff broke when upgrading to acl2 3.5 - use fn-measure!
;         (justification (nth 4 (lookup-eq 'justification props1))) ;fixme what exactly is the format of the justification?
;        (justification (sublis-var-simple (pairlis$ formals1 new-formals1) justification))
         )
    (mv-let (expr rec-callp)
            (make-induction-function-aux body1 fn1 body2 new-formals2 induction-fn-name fn2)
            (declare (ignore rec-callp))
            (let ((defun `(defun ,induction-fn-name ,(append new-formals1 new-formals2)
                            (declare (xargs :normalize nil))
                            ;;(declare (xargs :measure ,justification))
                            ,expr)))
              (prog2$ nil ;(cw ",,Induction function: ~x0~%" defun)
                      `(skip-proofs
                        ,defun))))))

;makes a joint induction function for FN1 and FN2
;renames the params to make them unique
;could check that they are in fact recursive
;returns a defun
;ffixme what does this do if one of the functions is undefined?
;; todo: just take world?
(defun make-induction-function (fn1 fn2 induction-fn-name state)
  (declare (xargs :guard (and (symbolp fn1)
                              (symbolp fn2)
                              (symbolp induction-fn-name))
                  :stobjs state))
  (let* (;;(props1 (getprops-non-nil fn1 state))
         ;;(props2 (getprops-non-nil fn2 state))
         ;;(body1 (lookup-eq-safe 'unnormalized-body props1))
         ;;(body2 (lookup-eq-safe 'unnormalized-body props2))
         (body1 (fn-body fn1 t (w state)))
         (body2 (fn-body fn2 t (w state)))
         ;;(formals1 (lookup-eq-safe 'formals props1))
         ;;(formals2 (lookup-eq-safe 'formals props2))
         (formals1 (fn-formals fn1 (w state)))
         (formals2 (fn-formals fn2 (w state)))
         )
    (make-induction-function-helper fn1 formals1 body1 fn2 formals2 body2 induction-fn-name)))

(defun make-induction-function2 (fn1 fn2 formals2 body2 induction-fn-name state)
  (declare (xargs :guard (and (symbolp fn1)
                              (symbolp fn2)
                              (symbol-listp formals2)
                              (pseudo-termp body2)
                              (symbolp induction-fn-name))
                  :stobjs state))
  (let* (;(props1 (getprops fn1 'current-acl2-world (w state)))
         ;;(body1 (lookup-eq 'unnormalized-body props1))
         (body1 (fn-body fn1 t (w state)))
         ;(formals1 (lookup-eq 'formals props1))
         (formals1 (fn-formals fn1 (w state))))
    (make-induction-function-helper fn1 formals1 body1 fn2 formals2 body2 induction-fn-name)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;fixme check the arity of functions mentioned here? also check that the functions mentioned are not macros (like "+")
;fixme check that all keys in the entry are allowed
(defun extra-stuff-okayp-aux (keys extra-stuff)
  (declare (xargs :guard t))
  (if (atom keys)
      t
    (let* ((key (car keys))
           (entry (g key extra-stuff)))
      (and (subsetp-eq (dom entry) '(:extra-hyps
                                    :remove-hyps
                                    :explanations
                                    :explanations-to-remove
                                    :connections
                                    :connections-to-remove
                                    :extra-rv-claims
                                    :print-traces
                                    :split
                                    :unrolling-factor
                                    :complete-unrolling-amount
                                    ;;can appear in options:
                                    :do-not-drop
                                    ))
           (pseudo-term-listp (g :extra-hyps entry))
           (pseudo-term-listp (g :remove-hyps entry))
           (pseudo-term-listp (g :explanations entry))
           (pseudo-term-listp (g :explanations-to-remove entry))
           (pseudo-term-listp (g :connections entry))
           (pseudo-term-listp (g :connections-to-remove entry))
           (pseudo-term-listp (g :extra-rv-claims entry))
           (pseudo-term-listp (g :print-traces entry))
           (let ((split (g :split entry)))
             (or (not split)
                 (pseudo-termp split)))
           ;;            ;fixme do we still use this?!
           ;;            (let ((old-var-to-formal-alist (g :old-var-to-formal-alist entry)))
           ;;              (and (my-all->=-len old-var-to-formal-alist 2)
           ;;                   (pseudo-term-listp (strip-cadrs old-var-to-formal-alist))))

           (extra-stuff-okayp-aux (cdr keys) extra-stuff)))))

(defun extra-stuff-okayp (extra-stuff)
  (declare (xargs :guard t))
  (and (wfr extra-stuff)
       (let ((keys (dom extra-stuff)))
         (and (symbol-listp keys)
              (extra-stuff-okayp-aux keys extra-stuff)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun make-arg-symbols (current symbol)
  (declare (xargs :guard (and (integerp current)
                              (symbolp symbol))
                  :measure (nfix (+ 1 current))))
  (if (not (natp current))
      nil
    (cons (pack$ symbol (nat-to-string current))
          (make-arg-symbols (+ -1 current) symbol))))

(local
 (defthm symbol-listp-of-make-arg-symbols
     (symbol-listp (make-arg-symbols current symbol))))

(defun nth-nest-around-some-symbol (term symbols)
  (declare (xargs :guard (and (pseudo-termp term)
                              (symbol-listp symbols))))
  (if (atom term)
      (member-eq term symbols)
    (and (eq 'nth (ffn-symb term))
         (quotep (first (fargs term)))
         (nth-nest-around-some-symbol (second (fargs term)) symbols))))

(mutual-recursion
 (defun get-mentioned-arg-components-aux (term arg-symbols)
   (declare (xargs :guard (and (pseudo-termp term)
                               (symbol-listp arg-symbols))
                   :verify-guards nil ; done below
                   ))
   (if (atom term)
       (member-eq term arg-symbols)
     (if (quotep term)
         nil
       (if (nth-nest-around-some-symbol term arg-symbols)
           (list term)
         (get-mentioned-arg-components-aux-lst (fargs term) arg-symbols)))))

 (defun get-mentioned-arg-components-aux-lst (terms arg-symbols)
   (declare (xargs :guard (and (pseudo-term-listp terms)
                               (symbol-listp arg-symbols))))
   (if (endp terms)
       nil
     (append (get-mentioned-arg-components-aux (car terms) arg-symbols)
             (get-mentioned-arg-components-aux-lst (cdr terms) arg-symbols)))))

(local (make-flag get-mentioned-arg-components-aux))

(local
 (defthm-flag-get-mentioned-arg-components-aux
     (defthm theorem-for-get-mentioned-arg-components-aux
         (implies (and (pseudo-termp term)
                       (symbol-listp arg-symbols))
                  (true-listp (get-mentioned-arg-components-aux term arg-symbols)))
       :flag get-mentioned-arg-components-aux)
     (defthm theorem-for-get-mentioned-arg-components-aux-lst
         (implies (and (pseudo-term-listp terms)
                       (symbol-listp arg-symbols))
                  (true-listp (get-mentioned-arg-components-aux-lst terms arg-symbols)))
       :flag get-mentioned-arg-components-aux-lst)))

(verify-guards get-mentioned-arg-components-aux)

(defun get-mentioned-arg-components (terms arity symbol)
  (declare (xargs :guard (and (pseudo-term-listp terms)
                              (natp arity)
                              (symbolp symbol))))
  (let* ((arg-symbols (make-arg-symbols arity symbol)))
    (get-mentioned-arg-components-aux-lst terms arg-symbols)))





;a and b are both nests of calls to nth
(defun disjoint-components (a b)
  (and (not (subtermp a b))
       (not (subtermp b a))))

(defun disjoint-component-from-all (item lst)
  (if (endp lst)
      t
    (and (disjoint-components item (car lst))
         (disjoint-component-from-all item (cdr lst)))))

(defun all-disjoint-components (lst1 lst2)
  (if (endp lst1)
      t
    (and (disjoint-component-from-all (car lst1) lst2)
         (all-disjoint-components (cdr lst1) lst2))))

(defun hyp-mentions-a-componentp (hyp components arg-symbols)
  (not (all-disjoint-components (get-mentioned-arg-components-aux hyp arg-symbols)
                                components)))

;;components are things like (nth '4 (nth '5 arg1)) or (nth '6 arg2) or arg3
;;a hyp which mentions (nth '1 arg0) does not count as mentioning (nth '2 arg0)
;but a HYP which mentions arg0 without a surrounding nth does (could ignore things inside true-listp and len in that case)
(defun keep-hyps-about-components-aux (hyps components arg-symbols)
  (if (endp hyps)
      nil
    (if (hyp-mentions-a-componentp (car hyps) components arg-symbols)
        (cons (car hyps) (keep-hyps-about-components-aux (cdr hyps) components arg-symbols))
      (keep-hyps-about-components-aux (cdr hyps) components arg-symbols))))

(defun keep-hyps-about-components (hyps components arity symbol)
  (let* ((arg-symbols (make-arg-symbols arity symbol)))
    (keep-hyps-about-components-aux hyps components arg-symbols)))

;actually fn-name may be the name of a theorem about 2 rec fns.. - that feature not used anymore?
(defun get-extra-concs (fn-name extra-stuff)
  (let* ((extra-stuff-for-fn (lookup-equal fn-name extra-stuff))
         (match (g :extra-concs extra-stuff-for-fn)))
    (if match
        (prog2$ (cw ",,Using user-supplied concs: ~x0.~%" match)
                match)
      nil)))

;; (defun get-extra-strengthenable-pred-infos (fn-name extra-stuff)
;;   (let* ((extra-stuff-for-fn (lookup-eq fn-name extra-stuff))
;;          (match (g :strengthenable-pred-infos extra-stuff-for-fn)))
;;     (if match
;;         (prog2$ (cw ",,Using user-supplied strengthenable-pred-infos: ~x0.~%" match)
;;                 match)
;;       nil)))

;use a map
(defun car-list (x)
  (if (endp x)
      nil
    (cons (car (car x))
          (car-list (cdr x)))))

;use a map
(defun cdr-list (x)
  (if (endp x)
      nil
    (cons (cdr (car x))
          (cdr-list (cdr x)))))

;maybe not needed
(defthm car-of-cdr-list
  (equal (car (cdr-list x))
         (cdr (car x))))

;each trace is a sequence of tuples of the form: (arg1val arg2val arg3val ... argnval)
;each trace results in many test-cases for the params of the rec. fn.
(defun make-test-cases-for-formal-rev (formals trace test-case-acc)
  (if (endp trace)
      test-case-acc
    (make-test-cases-for-formal-rev  formals
                                    (cdr trace)
                                    (cons (pairlis$ formals (car trace))
                                          test-case-acc))))

;args-traces is a list of traces
;each trace is a sequence of tuples of the form: (arg1val arg2val arg3val ... argnval)
;each trace results in many test-cases for the params of the rec. fn.
;each test case is an alist binding the formals?
(defun make-test-cases-for-formals-aux (formals args-traces test-case-acc)
  (if (endp args-traces)
      ;;the traces are processed in reverse order, and each trace gives test cases in reverse order, so reversing here at the end makes everything in order:
      (reverse test-case-acc)
    (make-test-cases-for-formals-aux formals
                                    (cdr args-traces)
                                    (make-test-cases-for-formal-rev formals
                                                                   (car args-traces)
                                                                   test-case-acc))))

;fffffixme don't include the last call (the one that doesn't execute the body of the function?)
(defun make-test-cases-for-formals (formals args-traces)
  (prog2$ (prog2$ nil ;(cw "First trace:")
                  nil ;(print-list (car args-traces))
                  )
          (make-test-cases-for-formals-aux formals args-traces nil)))

;fixme make tail-rec if the order doesn't matter?
(defun extend-alist (keys vals alist)
  (declare (xargs :guard (and (true-listp keys)
                              (true-listp vals))))
  (if (endp keys)
      alist
    (acons-fast (car keys) (car vals)
                (extend-alist (cdr keys) (cdr vals) alist))))

;doesn't handle duplicate keys
(defun compose-alists (alist1 alist2)
  (if (endp alist1)
      nil
    (let* ((entry (car alist1))
           (key (car entry))
           (val (cdr entry)))
      (acons-fast key (lookup-equal val alist2)
                  (compose-alists (cdr alist1) alist2)))))

;throws away the last sample in the trace, because that one will make the exit test true, and we are generating tests for the loop body (which doesn't execute when the loop exits)
(defun make-test-cases-for-formals-and-old-vars-for-trace-rev (formals trace test-case-for-old-vars test-case-acc)
  (if (endp trace)
      test-case-acc ;should not happen; avoid testing this?
    (if (endp (rest trace))
        test-case-acc ;only one sample, and we always discard the last sample
      (make-test-cases-for-formals-and-old-vars-for-trace-rev formals
                                                              (rest trace)
                                                              test-case-for-old-vars
                                                              (cons (extend-alist formals (first trace) test-case-for-old-vars)
                                                                    test-case-acc)))))

;each args-trace is a sequence of tuples of the form: (arg1val arg2val arg3val ... argnval)
;throws away the last sample in each trace, because that one will make the exit test true, and we are generating tests for the loop body (which doesn't execute when the loop exits)
(defun make-test-cases-for-formals-and-old-vars-aux (formals old-var-to-formal-alist args-traces test-case-acc)
  (if (endp args-traces)
      ;;the traces are processed in reverse order, and each trace gives test cases in reverse order, so reversing here at the end makes everything in order: (fixme do i care about the order?)
      (reverse test-case-acc) ;ffffixme drop?
    (let ((args-trace (first args-traces)))
      (if (endp (cdr args-trace)) ;only one sample, and we always discard the last sample
          (make-test-cases-for-formals-and-old-vars-aux formals old-var-to-formal-alist (rest args-traces) test-case-acc)
        (let* ((first-call-vals (car args-trace))
               (first-call-alist (pairlis$ formals first-call-vals)) ;fixme save making this alist
               ;;pairs old-vars with their values in the first call frame:
               (test-case-for-old-vars (compose-alists old-var-to-formal-alist first-call-alist)) ;a bit gross to do it this way?
               (test-case-acc (make-test-cases-for-formals-and-old-vars-for-trace-rev formals args-trace test-case-for-old-vars test-case-acc)))
          (make-test-cases-for-formals-and-old-vars-aux formals old-var-to-formal-alist (rest args-traces) test-case-acc))))))

;none of the traces should be empty?
;throws away the last sample in each trace, because that one will make the exit test true, and we are generating tests for the loop body (which doesn't execute when the loop exits)
(defun make-test-cases-for-formals-and-old-vars (formals old-var-to-formal-alist args-traces)
  (prog2$ (prog2$ nil ;(cw "First trace:")
                  nil ;(print-list (car args-traces))
                  )
          (make-test-cases-for-formals-and-old-vars-aux formals old-var-to-formal-alist args-traces nil)))

;use defmap?
(defun append-list-aux (x y acc)
  (if (endp x)
      (reverse acc)
    (append-list-aux (rest x)
                     (rest y)
                     (cons (append (first x) (first y))
                           acc))))

(defun append-list (x y)
  (append-list-aux x y nil))

;; ;returns (mv flg update-fn)
;; (defun is-a-head-aux-function (fn state)
;;   (declare (xargs :stobjs state
;;                   :verify-guards nil))
;;   (let ((props (GETPROPS fn 'CURRENT-ACL2-WORLD (W STATE))))
;;     (if (not props)
;;         (mv (hard-error 'is-a-head-aux-function
;;                         "Can't find a function named ~x0." (list (cons #\0 fn)))
;;             nil)
;;       (let* ((body (lookup-eq-safe 'unnormalized-body props))
;;              (formals (lookup-eq-safe 'formals props))
;; ;             (function-call (cons function-name formals))
;;              )
;;         (if (and (equal formals '(reps x))
;;                  (consp body)
;;                  (eq 'if (ffn-symb body))
;;                  (equal '(zp reps) (first (fargs body)))
;;                  (eq 'x (second (fargs body)))
;;                  (consp (third (fargs body)))
;;                  (equal `(,fn (binary-+ '-1 REPS) X)
;;                         (first (fargs (third (fargs body))))))
;;             (mv t (ffn-symb (third (fargs body))))
;;           (mv nil nil))))))

(defun empty-analyzed-function-table () nil)

;; ;;returns (mv erp runes state)
;; (defun prove-update-fn-preserves-concs (hyps concs
;;                                              update-fn rune-num prover-rule-alist
;;                                              interpreted-function-alist runes-acc state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (endp concs)
;;       (mv nil runes-acc state)
;;     (let* ((conc (car concs))
;;            (rule-name (pack$ update-fn '-preserves-conc- (nat-to-string rune-num))))
;;       (mv-let (erp state)
;;               (my-defthm-fn2 rule-name
;;                             hyps
;;                             (list conc)
;;                             `(("Goal"
;;                                :in-theory (theory 'minimal-theory)
;;                                :do-not '(generalize eliminate-destructors))
;;                               (if STABLE-UNDER-SIMPLIFICATIONP
;;                                   '(:clause-processor
;;                                     (axe-prover
;;                                      clause
;;                                      ',(s :goal-name rule-name
;;                                           (axe-prover-hints
;;                                            nil
;;                                            prover-rule-alist interpreted-function-alist
;;                                            (empty-analyzed-function-table) ;fffixme
;;                                            ))
;;                                      state)
;;                                     :do-not '(generalize eliminate-destructors))
;;                                 nil))
;;                             t ; elide hints
;;                             nil
;;                             t
;;                             state)
;;               (if erp
;;                   (mv t nil state)
;;                 (prove-update-fn-preserves-concs hyps
;;                                                  (cdr concs)
;;                                                  update-fn
;;                                                  (+ 1 rune-num)
;;                                                  prover-rule-alist interpreted-function-alist
;;                                                  (cons `(:rewrite ,rule-name)
;;                                                        runes-acc)
;;                                                  state))))))



;;returns (mv erp state)
;; the formals of FN must be REPS and X.
;; concs are predicates over :var and x? - what about reps?
;do i need a connection between reps and x? maybe for the base case?
;do we need to pass in some hyps?
;; (defun prove-theorem-about-head-aux-function (theorem-name fn ;hyps
;;                                                            concs update-fn
;;                                                            prover-rule-alist
;;                                                            interpreted-function-alist state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (prog2$
;;    (cw ",,Proving theorem about head recursive function ~x0. concs: ~x1.~%" fn concs)
;;    (let* ((concs (remove-duplicates-equal concs)) ;move this out?
;;           (concs-of-x (sublis-var-simple-lst (acons :var 'x nil) concs))
;;           (concs-of-update (sublis-var-simple-lst (acons :var `(,update-fn x) nil) concs))
;;           (concs-of-fn (sublis-var-simple-lst (acons :var `(,fn reps x) nil) concs))
;;           (helper-theorem-name (pack$ theorem-name '-helper))
;;           )
;;      (mv-let (erp runes state)
;;              ;;for each conc, prove that update-fn preserves it
;;              (prove-update-fn-preserves-concs concs-of-x
;;                                               concs-of-update
;;                                               update-fn 0
;;                                               prover-rule-alist interpreted-function-alist
;;                                               nil state)
;;              (if erp
;;                  (mv t state)
;;                (mv-let (erp state)
;;                        (my-defthm-fn2
;;                         helper-theorem-name
;;                         concs-of-x
;;                         concs-of-update
;;                         `(("goal"
;;                            :in-theory (theory 'minimal-theory)
;;                            :do-not '(generalize eliminate-destructors)
;;                            :use (,@(strip-cadrs runes))))
;;                         t
;;                         nil
;;                         t
;;                         state)
;;                        (if erp
;;                            (mv t state)
;;                          (my-defthm-fn-rewrite
;;                           theorem-name
;;                           concs-of-x
;;                           concs-of-fn
;;                           `(("Goal" :use ((:instance
;;                                            (:functional-instance generic-pred-of-generic-head-aux
;;                                                                  (generic-update ,update-fn)
;;                                                                  (generic-head-aux ,fn)
;;                                                                  (generic-pred (lambda (x) ,(make-conjunction-from-list concs-of-x)))))
;;                                           ,helper-theorem-name)
;;                              :in-theory (theory 'minimal-theory)))
;;                           t
;;                           state))))))))

(defun nth-nest-around-item (term item)
  (or (equal term item)
      (and (consp term)
           (eq 'nth (ffn-symb term))
           (quotep (first (fargs term)))
           (nth-nest-around-item (second (fargs term)) item))))

;; ;all the preds should be equalities?
;; (defun filter-tail-rec-preds (preds fn-call)
;;   (if (endp preds)
;;       nil
;;     (let ((pred (car preds)))
;;       (if (and (eq 'equal (ffn-symb pred))
;;                (nth-nest-around-item (second pred) fn-call)
;;                (not (quotep (third pred)))
;;                (not (nth-nest-around-item (third pred) fn-call)))
;;           ;drop preds that equate a component with something other than a constant or another component (e.g., with a bvminus)
;;           (filter-tail-rec-preds (cdr preds) fn-call)
;;         (cons pred (filter-tail-rec-preds (cdr preds) fn-call))))))

;; returns (mv erp new-runes state)
;; FN must have the single formal PARAMS
;; preds are predicates over the variable PARAMS

(defun make-equalities (items1 items2)
  (declare (xargs :guard (and (true-listp items1)
                              (true-listp items2)
                              (equal (len items1)
                                     (len items2)))))
  (if (endp items1)
      nil
    (cons `(equal ,(first items1) ,(first items2))
          (make-equalities (rest items1) (rest items2)))))

;no target should contain another?
(mutual-recursion
 (defun find-terms (targets term)
   (if (member-equal term targets)
       (list term)
     (if (atom term)
         nil
       (if (quotep term)
           nil
         (find-terms-lst targets (fargs term))))))

 (defun find-terms-lst (targets terms)
   (if (endp terms)
       nil
     (append (find-terms targets (car terms))
             (find-terms-lst targets (cdr terms))))))

(defun find-term (target term)
  (find-terms (list target) term))



(defun lookup-equal-all (keys alist)
  (if (endp keys)
      nil
    (cons (lookup-equal (car keys) alist)
          (lookup-equal-all (cdr keys) alist))))

(defun make-bindings-for-use-hint (vars var-term-alist)
  (if (endp vars)
      nil
    (cons `(,(car vars) ,(lookup-eq-safe (car vars) var-term-alist))
          (make-bindings-for-use-hint (cdr vars) var-term-alist))))



;Proves one theorem for each conjunct of the invariant.
;for each theorem, this puts in exactly the right hyps about members of new-vars (i.e., the hyps for those that appear)
;returns (mv erp new-runes state)
;was filtering conjuncts in the conclusion but no longer
;now skips conclusions that are only about unchanged params

;;  ;; If the LHS of one of the final rules contains (nth <n> params) because of an unchanged
;; ;; param, the naive rule may not fire.  For example, say we've proved:
;; ;; (< (nth 0 (fn params)) (nth 2 (fn params)))
;; ;; but param2 is unchanged and so we've turned that into:
;; ;; (< (nth 0 (fn params)) (nth 2 params))
;; ;; When we want the rule to fire in a proof, params will be a cons nest, so the (nth 2 params)
;; ;; won't match, because nth of a cons nest gets simplified.
;; ;; So for any unchanged param, we'll replace (nth <n> params) with a var and add a
;; ;; hyp that it equals the var. - fixme only do it in left hand sides?
;; ;; could instead instantiate the theorem with params being a cons nest? - could that ever make it fail to fire?
;; (defun prove-final-theorems-about-tail-function (preds-of-pushed-back ;concs?
;;                                                  unchanged-components
;;                                                  base-theorem-name
;;                                                  fn-call
;;                                                  hyps
;;                                                  fn-preserves-preds-substituted-theorem-name
;;                                                  runes-acc next-thm-num
;;                                                  state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (endp preds-of-pushed-back)
;;       (mv nil runes-acc state)
;;     (let ((pred-of-fn-pushed-back (car preds-of-pushed-back)))
;;       (if (not (find-term fn-call pred-of-fn-pushed-back))
;;           ;;skip this pred (i.e., this conclusion) if it doesn't mention the fn-call at all (because we've substituted for unchanged params)
;;           (prog2$ (cw "Skipping conclusion ~x0 because it doesn't mention the function call.~%" pred-of-fn-pushed-back)
;;                   (prove-final-theorems-about-tail-function
;;                    (cdr preds-of-pushed-back) unchanged-components base-theorem-name fn-call hyps
;;                    fn-preserves-preds-substituted-theorem-name runes-acc next-thm-num state))
;;         (let* ((unchanged-components-mentioned (remove-duplicates-equal (find-terms unchanged-components pred-of-fn-pushed-back)))
;;                (new-vars (make-var-names-aux 'param-var- 1 (len unchanged-components-mentioned)))
;;                (unchanged-component-var-alist (pairlis$ unchanged-components-mentioned new-vars))
;;                (pred-of-fn-pushed-back-with-vars (replace-in-term2 pred-of-fn-pushed-back unchanged-component-var-alist))
;;                (var-equalities (make-equalities new-vars unchanged-components-mentioned))
;;                (theorem-name (packnew base-theorem-name '- (nat-to-string next-thm-num))))
;;           (mv-let (erp state)
;;                   (my-defthm
;;                    theorem-name
;;                    (append var-equalities hyps)
;;                    (list pred-of-fn-pushed-back-with-vars)
;;                    :hints
;;                    `(("Goal" :use ((:instance ,fn-preserves-preds-substituted-theorem-name))
;;                       :do-not '(generalize eliminate-destructors)
;;                       :in-theory (theory 'minimal-theory)))
;;                    :elide-hintsp nil
;;                    :print nil)
;;                   (if erp
;;                       (mv t nil state)
;;                     (prove-final-theorems-about-tail-function (cdr preds-of-pushed-back)
;;                                                               unchanged-components
;;                                                               base-theorem-name fn-call hyps
;;                                                               fn-preserves-preds-substituted-theorem-name
;;                                                               (cons `,theorem-name runes-acc)
;;                                                               (+ 1 next-thm-num)
;;                                                               state))))))))

;; ;each element of the return value is:
;; ;(cons stronger-predicate pred-numbers-that-support-it)
;; ;when we later prove the stronger predicate we'll also get to assume the exit test
;; (defun strengthenable-pred-infos (preds exit-test current-pred-number fn-call)
;;   (declare (xargs :mode :program))
;;   (if (endp preds)
;;       nil
;;     (let* ((pred (car preds))
;;            ;;tests whether
;;            ;;exit test is (not (bvlt '31 x y))
;;            ;;and pred is (equal (bvlt '31 y x) 'nil)
;;            (strengthened-pred
;;             (and (call-of 'not  exit-test) ;consp gets retested over and over?
;;                  (let ((exit-bvlt (first (fargs exit-test))))
;;                    (and (consp exit-bvlt)
;;                         (eq 'bvlt (ffn-symb exit-bvlt))
;;                         (quotep (first (fargs exit-bvlt)))
;;                         (consp pred)
;;                         (eq 'equal (ffn-symb pred))
;;                         (equal *nil* (second (fargs pred)))
;;                         (let ((pred-bvlt (first (fargs pred))))
;;                           (and (consp pred-bvlt)
;;                                (equal (first (fargs pred-bvlt))
;;                                       (first (fargs exit-bvlt)))
;;                                (equal (second (fargs pred-bvlt))
;;                                       (third (fargs exit-bvlt)))
;;                                (equal (third (fargs pred-bvlt))
;;                                       (second (fargs exit-bvlt)))
;; ;we try to orient the equality the right way:
;; ;if we can rewrite something about the fn-call to something about the params, we do that..
;;                                (let* ((term1 (second (fargs exit-bvlt)))
;;                                       (term2 (third (fargs exit-bvlt)))
;;                                       (term1-smallerp (if (find-term fn-call term1)
;;                                                           (if (find-term fn-call term2)
;;                                                               (smaller-termp term1 term2)
;;                                                             nil)
;;                                                         (if (find-term fn-call term2)
;;                                                             t
;;                                                           (smaller-termp term1 term2))))

;;                                       (small-term (if term1-smallerp term1 term2))
;;                                       (big-term (if term1-smallerp term2 term1)))
;;                                  `(equal ,big-term
;;                                          ,small-term)))))))))
;;       (if strengthened-pred
;;           ;currently strengthened pred is only supported by one pred, but that may change
;;           (cons (cons strengthened-pred (list current-pred-number))
;;                 (strengthenable-pred-infos (cdr preds) exit-test (+ 1 current-pred-number) fn-call))
;;         (strengthenable-pred-infos (cdr preds) exit-test (+ 1 current-pred-number) fn-call)))))

(defun make-alist-into-bindings (alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist)))
      (cons (list (car entry) (cdr entry))
            (make-alist-into-bindings (cdr alist))))))

;; ;;returns (mv failedp rune state)
;; ;ffixme is an unchanged theorem just an invariant with an auxiliary variable?
;; (defun prove-unchanged-theorem-about-tail-function (unchanged-component
;;                                                     formal-fn-call-component-alist
;;                                                     invariant-of-formals-and-old-vars
;;                                                     exit-test-expr
;;                                                     fn formal-update-expr-alist
;;                                                     rune-count updates-preserve-invar-theorem-name old-var-to-formal-alist state)
;;   (declare (xargs :mode :program :stobjs state))
;;   (let* ((formal (strip-nths-and-lens unchanged-component))
;;          (fn-call-component (lookup-eq formal formal-fn-call-component-alist)))
;;     (if (not fn-call-component)
;; ;this possibly-unchanged component is not among the formals returned:
;;         (mv t nil state)
;;       (let* ((formals (strip-cars formal-update-expr-alist))
;;              (update-expr (lookup-eq formal formal-update-expr-alist))
;;              (negated-exit-test `(equal ,exit-test-expr 'nil))
;;              (unchanged-after-update-theorem-name (pack$ fn '-unchanged-lemma-helper- (nat-to-string rune-count)))
;;              (main-theorem-helper-name (pack$ fn '-unchanged-lemma- (nat-to-string rune-count) '-helper))
;;              (main-theorem-name (pack$ fn '-unchanged-lemma- (nat-to-string rune-count))))
;;         (mv-let (failedp state)
;;                 ;;Prove that the update function preserves the unchangedness (assuming the invariant):
;; ;ffixme this had an error (unknown function): distinguish that from just a failure to prove...
;;                 (my-defthm unchanged-after-update-theorem-name
;;                            (list negated-exit-test invariant-of-formals-and-old-vars)
;;                            (list `(equal ,(subst-var update-expr formal unchanged-component)
;;                                          ,unchanged-component))
;;                            :print nil
;;                            :hints`(("Goal"
;;                                     :in-theory (theory 'minimal-theory)
;;                                     :do-not '(generalize eliminate-destructors))
;;                                    (if stable-under-simplificationp
;;                                        '(:clause-processor
;;                                          (axe-prover
;;                                           clause
;;                                           ',(s :goal-name unchanged-after-update-theorem-name nil) ;;more axe-prover-hints?
;;                                           state)
;;                                          :do-not '(generalize eliminate-destructors))
;;                                      nil)))
;;                 (if failedp
;;                     (mv t nil state)
;;                   (mv-let (erp state)
;;                           (my-defthm main-theorem-helper-name
;;                                      (list invariant-of-formals-and-old-vars)
;;                                      (list `(equal ;;,(subst-var `(,fn ,formal) formal unchanged-component)
;;                                              ,(subst-var fn-call-component formal unchanged-component)
;;                                              ,unchanged-component))
;;                                      :print nil
;;                                      :hints
;;                                      `(("Goal"
;;                                         ;;                                     ;fffixme can we still use this hint?
;;                                         ;;                                     :use ((:instance
;;                                         ;;                                            (:functional-instance
;;                                         ;;                                             generic-tail-pred2-of-generic-tail
;;                                         ;;                                             (generic-tail-update ,update-fn)
;;                                         ;;                                             (generic-tail-exit (lambda (,formal) ,exit-test-expr))
;;                                         ;;                                             (generic-tail ,fn)
;;                                         ;;                                             (generic-tail-pred (lambda (,formal) (make-conjunction-from-list preds)))
;;                                         ;;                                             ;;the unchangedness fact
;;                                         ;;                                             (generic-tail-pred2 (lambda (,formal) ;note the aux. var oldvalue:
;;                                         ;;                                                                   (equal ,unchanged-component oldvalue))))
;;                                         ;;                                            (oldvalue ,unchanged-component))
;;                                         ;;                                           ;;does this have any effect:?
;;                                         ;;                                           (:instance ,unchanged-after-update-theorem-name)
;;                                         ;;                                           (:instance ,updates-preserve-invar-theorem-name))
;;                                         :induct (,fn ,@formals)
;;                                         :in-theory (union-theories
;;                                                     '(,fn
;;                                                       ;;,(pack$ fn '-base) ;newly removed
;;                                                       )
;;                                                     (theory 'minimal-theory))
;;                                         :do-not '(generalize eliminate-destructors))
;;                                        (if stable-under-simplificationp
;;                                            '(:use ((:instance ,unchanged-after-update-theorem-name)
;;                                                    (:instance ,updates-preserve-invar-theorem-name))
;;                                                   :in-theory (union-theories (theory 'minimal-theory)
;;                                                                              '(,fn
;; ;,(pack$ fn '-base) ;newly removed
;;                                                                                ))
;;                                                   :do-not '(generalize eliminate-destructors))
;;                                          nil)))
;;                           (if erp
;;                               (mv (prog2$ (hard-error 'prove-unchanged-theorem-about-tail-function
;;                                                       "The full unchanged theorem should not fail if the update theorem succeeds."
;;                                                       nil)
;;                                           t)
;;                                   nil state)
;;                             ;;Prove the main theorem (with the old-vars put in):
;;                             (mv-let (erp state)
;;                                     (my-defthm main-theorem-name
;;                                                (list (sublis-var-simple old-var-to-formal-alist invariant-of-formals-and-old-vars))
;;                                                (list `(equal
;;                                                        ,(subst-var fn-call-component formal unchanged-component)
;;                                                        ,unchanged-component))
;;                                                :print nil
;;                                                :hints
;;                                                `(("Goal"
;;                                                   :use ((:instance ,main-theorem-helper-name ,@(make-alist-into-bindings old-var-to-formal-alist)))
;;                                                   :in-theory (theory 'minimal-theory)
;;                                                   :do-not '(generalize eliminate-destructors))))
;;                                     (if erp
;;                                         (mv t nil state)
;;                                       (mv nil `(:rewrite ,main-theorem-name) state)))))))))))

;; ;ffixme will we ever need to prove something about a nested loop to establish an unchangedness property?
;; ;; unchanged-components are nests of nths (perhaps with surrounding lens??) over the formals
;; ;; returns (provably-unchanged-components runes state)
;; ;; now returns a (possibly shorter) list of unchanged components
;; (defun prove-unchanged-theorems-about-tail-function
;;   (unchanged-components
;;    formal-fn-call-component-alist
;;    invariant-of-formals-and-old-vars ;preds
;;    exit-test-expr fn formal-update-expr-alist rune-count runes-acc
;;    provably-unchanged-components-acc updates-preserve-invar-theorem-name old-var-to-formal-alist state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (endp unchanged-components)
;;       (mv provably-unchanged-components-acc runes-acc state)
;;     (let ((unchanged-component (car unchanged-components)))
;;       (mv-let
;;        (failedp rune state)
;;        (prove-unchanged-theorem-about-tail-function unchanged-component
;;                                                     formal-fn-call-component-alist
;;                                                     invariant-of-formals-and-old-vars ;preds
;;                                                     exit-test-expr fn formal-update-expr-alist rune-count
;;                                                     updates-preserve-invar-theorem-name old-var-to-formal-alist state)
;;        (if failedp
;;            (prog2$ (cw ",,Failed to prove unchanged theorem about component ~x0.~%" unchanged-component)
;;                    (prove-unchanged-theorems-about-tail-function (cdr unchanged-components)
;;                                                                  formal-fn-call-component-alist
;;                                                                  invariant-of-formals-and-old-vars ;preds
;;                                                                  exit-test-expr
;;                                                                  fn
;;                                                                  formal-update-expr-alist
;;                                                                  rune-count ;leaving the count
;;                                                                  runes-acc ;not adding the rule
;;                                                                  provably-unchanged-components-acc ;not adding
;;                                                                  updates-preserve-invar-theorem-name
;;                                                                  old-var-to-formal-alist
;;                                                                  state))
;;          (prove-unchanged-theorems-about-tail-function (cdr unchanged-components)
;;                                                        formal-fn-call-component-alist
;;                                                        invariant-of-formals-and-old-vars ;preds
;;                                                        exit-test-expr
;;                                                        fn
;;                                                        formal-update-expr-alist
;;                                                        (+ 1 rune-count)
;;                                                        (cons rune runes-acc)
;;                                                        (cons unchanged-component provably-unchanged-components-acc)
;;                                                        updates-preserve-invar-theorem-name
;;                                                        old-var-to-formal-alist
;;                                                        state))))))

(defun get-consed-items-from-cons-nest (nest)
  (if (call-of 'cons nest)
      (cons (first (fargs nest))
            (get-consed-items-from-cons-nest (second (fargs nest))))
    (if (equal *nil* nest)
        nil
      (hard-error 'get-consed-items-from-cons-nest "Expected a cons nest but got ~x0."
                  (acons #\0 nest nil)))))

(defun keep-terms-that-mention-only (vars terms)
  (if (endp terms)
      nil
    (if (subsetp-eq (get-vars-from-term (car terms)) vars)
        (cons (car terms)
              (keep-terms-that-mention-only vars (cdr terms)))
      (keep-terms-that-mention-only vars (cdr terms)))))

(defun make-nths-of-symbol (nths base-symbol)
  (if (endp nths)
      nil
    (cons `(nth ',(car nths) ,base-symbol)
          (make-nths-of-symbol (cdr nths) base-symbol))))

(defun keep-terms-that-mention (target terms)
  (if (endp terms)
      nil
    (let* ((term (car terms)))
      (if (subtermp target term)
          (cons term (keep-terms-that-mention target (cdr terms)))
        (keep-terms-that-mention target (cdr terms))))))


(defun make-equalities-from-alist (alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry))
           (value (cdr entry)))
      (cons `(equal ,key ,value)
            (make-equalities-from-alist (cdr alist))))))

;; (defun strip-function-calls (term fn-arg-alist)
;;   (if (atom term)
;;       term
;;     (let ((fn (ffn-symb term)))
;;       (if (eq 'quote fn)
;;           term
;;         (let ((match (lookup-eq (ffn-symb term) fn-arg-alist)))
;;           (if (not match)
;;               term
;;             (strip-function-calls (nth match (fargs term)) fn-arg-alist)))))))

;(defmap strip-function-calls-lst (terms fn-arg-alist) (strip-function-calls terms fn-arg-alist) :fixed (fn-arg-alist))

(defun strip-len-and-nth-alist ()
  (acons-fast 'len 0 (acons-fast 'nth 1 nil)))

;; (mutual-recursion
;;  (defun make-var-name-from-term (term)
;;    (if (atom term)
;;        (if (symbolp term)
;;            term
;;          (hard-error 'make-var-name-from-term "unexpected thing" nil))
;;      (let ((fn (ffn-symb term)))
;;        (if (eq fn 'quote)
;;            (if (natp (unquote term))
;;                (pack$ (unquote term))
;;              (hard-error 'make-var-name-from-term "unexpected thing2" nil))
;;          (pack$ fn
;;                (make-var-name-from-terms (fargs term)))))))

;;  (defun make-var-name-from-terms (terms)
;;    (if (endp terms)
;;        nil ;error
;;      (if (endp (cdr terms))
;;          (pack$ '-
;;                (make-var-name-from-term (car terms)))
;;        (pack$ '-
;;              (make-var-name-from-term (car terms))
;;              (make-var-name-from-terms (cdr terms)))))))

;; ;we must avoid a name clash with the formals
;; (defun make-old-var-names (components acc names-to-avoid)
;;   (if (endp components)
;;       (reverse acc)
;;     (let* ((component (car components))
;;            (desired-name (pack$ 'old- (make-var-name-from-term component)))
;;            (name (fresh-symbol desired-name names-to-avoid)))
;;       (make-old-var-names (cdr components)
;;                           (cons name acc)
;;                           (cons name names-to-avoid)))))

;avoids name clashes with the NAMES-TO-AVOID passed in and with any other name generated by this call of this function
(defun make-old-var-names-aux (formals acc names-to-avoid)
  (if (endp formals)
      (reverse acc)
    (let* ((formal-inside-old (first formals))
           (desired-name (pack$ 'old- formal-inside-old))
           (name (fresh-symbol desired-name names-to-avoid)))
      (make-old-var-names-aux (rest formals)
                              (cons name acc)
                              (cons name names-to-avoid)))))

;avoids name clashes
(defun make-old-var-names (formals)
  (make-old-var-names-aux formals nil formals))

(defun assoc-flipped-eq (x alist)
  (cond ((endp alist) nil)
        ((eq x (cdr (car alist))) (car alist))
        (t (assoc-flipped-eq x (cdr alist)))))

(defun lookup-flipped-eq (key alist)
  (cdr (assoc-flipped-eq key alist)))

(defun lookup-flipped-lst-eq (terms alist)
  (if (endp terms)
      nil
    (cons (lookup-flipped-eq (car terms) alist)
          (lookup-flipped-lst-eq (cdr terms) alist))))

(defun make-alist-from-equalities (equalities)
  (if (endp equalities)
      nil
    (let* ((equality (car equalities))
           (lhs (second equality))
           (rhs (third equality)))
      (acons-fast lhs rhs (make-alist-from-equalities (cdr equalities))))))

;these will mention formals and old-vars
(defun make-unchanged-var-invars (unchanged-components formal-to-old-var-alist)
  (if (endp unchanged-components)
      nil
    (let* ((unchanged-component (first unchanged-components)))
      (cons `(equal ,unchanged-component ,(replace-in-term2 unchanged-component formal-to-old-var-alist))
            (make-unchanged-var-invars (rest unchanged-components) formal-to-old-var-alist)))))



;; ;returns (mv success-flg matching-term alist)
;; ;just finds one match
;; (defun unify-any-term (terms pattern)
;;   (if (endp terms)
;;       (mv nil nil nil)
;;     (mv-let (success-flg alist)
;;             (unify-term (car terms) pattern)
;;             (if success-flg
;;                 (mv t (car terms) alist)
;;               (unify-any-term (cdr terms) pattern)))))

;; ;;return (mv lhs rhs) where one if x and the other is y
;; ;fixme does this do the right thing with old vars?
;; (defun orient-equality (formals x y)
;;   (let* ((vars-in-x (get-vars-from-term x))
;;          (vars-in-y (get-vars-from-term x))
;;          (formals-in-x (intersection-eq formals vars-in-x))
;;          (formals-in-y (intersection-eq formals vars-in-y))
;;          (x-smallerp (if formals-in-x
;;                          (if formals-in-y
;;                              t ;arbitrary
;;                            nil)
;;                        (if formals-in-y
;;                            t
;;                          t ; arbitrary
;;                          )))
;;          (lhs (if x-smallerp x y))
;;          (rhs (if x-smallerp y x)))
;;     (mv lhs rhs)))



;tests whether the expr is a call of a user function on some subset of formals
;fixme call this when we expand the exit test in dropping?
;fixme don't bother to check the formals?
;deprecate in favor of the version that doesn't take formals
(defun call-of-user-fn-on-formalsp (expr formals)
  (and (consp expr)
       (symbolp (ffn-symb expr)) ;todo: handle the lambda case
       (not (member-eq (ffn-symb expr) *built-in-fns*))
       (symbol-listp (fargs expr))
       (subsetp-eq (fargs expr) formals)))

(defun call-of-user-fnp (expr)
  (and (consp expr)
       (symbolp (ffn-symb expr)) ;todo: handle the lambda case
       (not (member-eq (ffn-symb expr) *built-in-fns*))
       (symbol-listp (fargs expr))))


;fixme call this when we expand the exit test in dropping?
(defun expand-fn-call-expr (expr state)
  (declare (xargs :stobjs state
                  :verify-guards nil))
  (let* ((exit-test-fn (ffn-symb expr))
         (exit-test-fn-body (fn-body exit-test-fn t (w state)))
         (exit-test-fn-formals (fn-formals exit-test-fn (w state))))
    (sublis-var-simple (pairlis$ exit-test-fn-formals
                              (fargs expr))
                  exit-test-fn-body)))

;expr is a call of a user function
;returns (mv expanded-body state).  state has defthm-name proved in it, connecting the expr and the expanded-expr
(defun expand-fn-call-expr-and-prove-theorem (expr defthm-name state)
  (declare (xargs :mode :program ;because this calls submit-event
                  :stobjs state))
  (let* ((fn (ffn-symb expr))
         (fn-body (fn-body fn t (w state)))
         (fn-formals (fn-formals fn (w state)))
         (expanded-expr (sublis-var-simple (pairlis$ fn-formals (fargs expr)) fn-body))
         (state (submit-event-brief `(defthm ,defthm-name
                                 (equal ,expr
                                        ,expanded-expr)
                                 :rule-classes nil
                                 :hints (("Goal" :in-theory (union-theories '(,fn) (theory 'minimal-theory)))))
                              state))
         )
    (mv expanded-expr state)))



;;               (state (submit-events-brief `( ;; Prove that the invariant implies the rv-predicate on the base-case when the function exits:


;;               (state
;;                (submit-events-brief `( ;;this just opens up the rv predicate:
;;                          state)))

;;          ;; The function may have several formals but only returns a single value (may be a tuple), so we need a new predicate for the RV.  But since the base case is simple (a single param or a tuple of some of the params), the rv-predicate should be easy to derive from the invars.
;;          ;;We've proved that the predicate holds over the return value (and maybe some pushed-back formals), but some components of the RV may be unchanged from the initial params, so we can do better if we substitute in the corresponding params. example: ...?
;;                  (let* ( ;;e.g., replace (nth 8 (<function> <formal>)) (or whatever the correct component of the RV is) with (nth 10 <formal>), if (nth 10 <formal>) is in probably-unchanged-components
;;                         (unchanged-fn-call-components (sublis-var-simple-lst formal-fn-call-component-alist probably-unchanged-components))
;;                         (subst-alist-for-unchanged (pairlis$ unchanged-fn-call-components probably-unchanged-components))

;;                         ;; prove a len theorem for the rv?  (may not be an atom?)

;;                         ;; these are over the fn-call and the formals:
;;                         (conjuncts-for-rv-predicate-instantiated2
;;                          (replace-in-terms2 conjuncts-for-rv-predicate-instantiated
;;                                             subst-alist-for-unchanged))
;;                         ;drop any conjuncts that have had all mentions of the fn-call pushed back to be about the formals:
;;                         (conjuncts-for-rv-predicate-instantiated2
;;                          (keep-terms-that-mention fn-call conjuncts-for-rv-predicate-instantiated2))

;;                         (state (submit-events-brief `( ;; this one has the unchanged components of the RV replaced by their params:
;;                                            ;;what if some unchanged components don't appear in the rv invars?
;; ;e.g., (nth 1 (nth 2 formal10)) is unchanged but only (nth 2 formal10) appears?
;;                                            ;;maybe if we know the length of (nth 2 formal10) we should rewrite it as an
;;                                            ;;cons of nth nest?
;;                                            (defthm ,fn-obeys-rv-predicates-pushed-back-theorem-name
;;                                              (implies ,invariant-of-formals-no-old-vars
;;                                                       ,(make-conjunction-from-list conjuncts-for-rv-predicate-instantiated2))
;;                                              :hints (("Goal" :use ((:instance ,fn-obeys-rv-predicates-theorem-name)
;;                                                                     ,@unchanged-runes)
;;                                                        :in-theory (theory 'minimal-theory)))))
;;                                          state))


;;                         zz
;;                         (exit-test-expr-of-fn-call (subst-var .. formal exit-test-expr)


;;                         )
;;                    (mv nil
;;                        `((:definition ,invariant-name)
;;                          (:rewrite ,fn-obeys-rv-predicates-pushed-back-theorem-name)) ;(append final-runes strengthened-runes)
;;                        unchanged-runes
;;                        (list invariant-name) ;needed?
;;                        state))))))))

;;                         zz things may not match

;;                         (mv-let
;;                                    (erp final-runes state) ;ffixme not really "final"
;;                                    ;;for each conjunct we include the equality hyps about only the relevant vars
;;                                    ;;(or else there will be free vars)
;;                                    (prove-final-theorems-about-tail-function invars-of-fn-pushed-back
;;                                                                              probably-unchanged-components
;;                                                                              base-theorem-name
;;                                                                              fn-call
;;                                                                              invars-no-aux
;;                                                                              fn-obeys-rv-predicates-pushed-back-theorem-name
;;                                                                              nil 0 state)
;;                                    (if erp (mv t nil nil state)
;;                                      (let*
;;                                          (
;;
;;                                           ;;this has the original params put in for any unchanged RVs:
;;                                           (simplified-exit-test-body-of-fn-pushed-back
;;                                            (replace-in-term2 simplified-exit-test-body-of-fn
;;                                                           subst-alist-for-unchanged))
;;                                           (dummy (cw "Exit test to compare: ~x0~%" simplified-exit-test-body-of-fn-pushed-back))
;;                                           (strengthenable-pred-infos
;;                                            (strengthenable-pred-infos invars-of-fn-pushed-back
;;                                                                       simplified-exit-test-body-of-fn-pushed-back
;;                                                                       0 fn-call))
;;                                           (strengthenable-pred-infos (append strengthenable-pred-infos
;;                                                                              (get-extra-strengthenable-pred-infos fn extra-stuff))))
;;                                        (declare (ignore dummy dummy2))
;;                                        (if (not strengthenable-pred-infos)
;;                                            (prog2$ (cw "Can't strengthen any pred. with the exit test.~%")
;;                                                    (mv nil final-runes unchanged-runes state))
;;                                          ;;the exit test can strengthen at least one predicate:
;;                                          (let* ((exit-test-of-fn-call-theorem-name (pack$ exit-fn '-of- fn))
;;                                                 (simplified-exit-test-of-fn-call-helper-theorem-name (pack$ exit-fn '-of-fn-call-simplified-helper))
;;                                                 (simplified-exit-test-of-fn-call-theorem-name1 (pack$ exit-fn '-of-fn-call-simplified))
;;                                                 ;;simplified and substituted:
;;                                                 (simplified-exit-test-of-fn-call-theorem-name2 (pack$ exit-fn '-theorem))

;;                                                 (exit-test-strengthening-events
;;                                                  ;;prove that the fn-call satisfies the exit test:
;;                                                  `( ;;do this even if no strengthenable invars?!
;;                                                    (defthm ,exit-test-of-fn-call-theorem-name
;;                                                      (,exit-fn ,fn-call)
;;                                                      :rule-classes nil
;;                                                      :hints (("Goal" :use
;;                                                               (:instance
;;                                                                (:functional-instance
;;                                                                 generic-tail-exit-of-generic-tail
;;                                                                 (generic-tail-update ,update-fn)
;;                                                                 (generic-tail-exit ,exit-fn)
;;                                                                 (generic-tail ,fn)))
;;                                                               :in-theory (union-theories
;;                                                                           '( ;needed?:
;;                                                                             ,fn
;;                                                                             ;;,(pack$ fn '-base) newly removed
;;                                                                             )
;;                                                                           (theory 'minimal-theory)))))

;; ;we need enough rules enabled here to do whatever simplifications we did above
;;                                                    ;;trying with axe-prover...
;;                                                    (defthm ,simplified-exit-test-of-fn-call-helper-theorem-name
;;                                                      (implies ,(make-conjunction-from-list
;;                                                                 invars-no-aux-of-fn-call) ;(,invariant-name (,fn params) ,@old-vars) ;use the invar with no-old-vars?
;;                                                               ,simplified-exit-test-body-of-fn)
;;                                                      :rule-classes nil
;;                                                      :hints (("Goal" :use (,exit-test-of-fn-call-theorem-name)
;;                                                               :do-not '(generalize eliminate-destructors)
;;                                                               :do-not-induct t
;;                                                               :in-theory (theory 'minimal-theory))
;;                                                              (if stable-under-simplificationp
;;                                                                  '(:clause-processor
;;                                                                    (axe-prover
;;                                                                     clause
;;                                                                     ',(axe-prover-hints
;;                                                                        (append `((:definition ,exit-fn))
;;                                                                                (exit-test-simplification-rules))
;;                                                                        ;;ffixme this causes a lot of printing!!
;;                                                                        prover-rule-alist
;;                                                                        nil ;interpreted-function-alist
;;                                                    (empty-analyzed-function-table) ;fffixme
;;                                                                        )
;;                                                                     state)
;;                                                                    :do-not '(generalize eliminate-destructors))
;;                                                                nil)))

;;                                                    ;;pushes the hyp back to be about the params, not the RVs:
;;                                                    (defthm ,simplified-exit-test-of-fn-call-theorem-name1
;;                                                      (implies ,(make-conjunction-from-list invars-no-aux)
;;                                                               ,simplified-exit-test-body-of-fn)
;;                                                      :rule-classes nil
;;                                                      :hints (("Goal" :use
;;                                                               (,fn-obeys-rv-predicate-theorem-name-no-aux
;;                                                                ,simplified-exit-test-of-fn-call-helper-theorem-name)
;;                                                               :in-theory (theory 'minimal-theory))))

;;                                                    ;;replaces unchanged RVs by their params:
;;                                                    ;;doesn't have any vars put in:
;;                                                    (defthm ,simplified-exit-test-of-fn-call-theorem-name2
;;                                                      (implies ,(make-conjunction-from-list invars-no-aux)
;;                                                               ,simplified-exit-test-body-of-fn-pushed-back)
;;                                                      :rule-classes nil
;;                                                      :hints (("Goal" :use (,simplified-exit-test-of-fn-call-theorem-name1
;;                                                                            ;;restrict to only those needed?:
;;                                                                            ,@unchanged-runes)
;;                                                               :in-theory (union-theories (theory 'minimal-theory)
;;                                                                                          '(,exit-fn))))))))
;;                                            (mv-let (erp result state)
;;                                                    (submit-events-brief exit-test-strengthening-events t state)
;;                                                    (declare (ignore result))
;;                                                    (if erp
;;                                                        (mv t nil nil state)
;;                                                      (mv-let (erp strengthened-runes state)
;;                                                              (make-strengthened-rules
;;                                                               strengthenable-pred-infos base-theorem-name
;;                                                               fn-call
;;                                                               invars-no-aux
;;                                                               probably-unchanged-components
;;                                                               simplified-exit-test-of-fn-call-theorem-name2 ;or do we want the 1 version? (if so, drop the 2 version)
;;                                                               fn-obeys-rv-predicates-pushed-back-theorem-name
;;                                                               prover-rule-alist
;;                                                               nil ;runes-acc
;;                                                               state)
;;                                                              (if erp
;;                                                                  (mv t nil nil state)
;;                                                                (mv nil
;;                                                                    (append final-runes strengthened-runes)
;;                                                                    unchanged-runes
;;                                                                    state)))))))))))))))))))))))
;; ;)
;; ;)
;;      )))
;;     ;; For each invar, prove that the update-exprs preserve it.  The invar is over the formals and the old-vars.
;;     ;; After the params are all updated, the conjunct should still hold.
;;     (mv-let
;;      (erp update-preserves-invars-runes state) ;what does erp mean here?
;;      (prove-update-fn-preserves-preds invars-of-update
;; ;should we pass in the invariant here?
;;                                       (cons negated-exit-test invars) ;we get to assume the negation of the exit test
;;                                       (pack$ fn '-update)
;;                                       0
;;                                       prover-rule-alist extra-stuff interpreted-function-alist
;;                                       nil test-cases-for-formals state)
;;      (if erp
;;          (mv t nil nil nil state)




;;          (mv-let (unchanged-components unchanged-runes state)
;;                  ;;some of these may fail, but that's okay, I guess...
;;                  ;fffixme what if the theorem is a about a formal that is not returned?!
;;                  ;;fold unchangedness into the old-var stuff?
;;                  (prove-unchanged-theorems-about-tail-function unchanged-components
;;                                                                formal-fn-call-component-alist
;;                                                                invariant-of-formals-and-old-vars
;;                                                                exit-test-expr
;;                                                                fn
;;                                                                formal-update-expr-alist
;;                                                                0 nil nil
;;                                                                updates-preserve-invariant-theorem-name old-var-to-formal-alist state)


;some of this stuff is duplicated in drop-params-from-tail-function? pull out the proving of the invariant into the caller!
    ;;     (mv-let
    ;;      (erp result state)
    ;;      ;; define the invariant:
    ;;      ;;(abuse of progn for 1 event?)
    ;;      (submit-events-brief `((defun ,invariant-name (params ,@old-vars) declare...
    ;;                       ,(make-conjunction-from-list preds)))
    ;;                   t state)
    ;;      (declare (ignore result))
;instead of calling my-defthm-fn repeatedly, just make a list of events and call submit-events-brief?
;;     (if erp
;;         (mv t nil nil state)


;doesn't handle lambdas
(skip-proofs
 (mutual-recursion
  (defun exhaustively-replace (term alist)
    (let* ((match (assoc-equal term alist)))
      (if match
          (exhaustively-replace (cdr match) alist)
        ;;the whole thing doesn't match, so try the subterms:
        (if (atom term)
            term
          (if (quotep term)
              term
            (cons (ffn-symb term)
                  (exhaustively-replace-lst (fargs term) alist)))))))

  (defun exhaustively-replace-lst (terms alist)
    (if (endp terms)
        nil
      (cons (exhaustively-replace (car terms) alist)
            (exhaustively-replace-lst (cdr terms) alist))))))

(defun closure-of-replacement-alist-aux (alist whole-alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry))
           (val (cdr entry)))
      (acons-fast key
             (exhaustively-replace val whole-alist)
             (closure-of-replacement-alist-aux (cdr alist) whole-alist)))))

;there should be no circularity in the ALIST passed in
;;example: (closure-of-replacement-alist (acons '(nth '0 y) 'z (acons 'x '(nth '2 (nth '0 y)) (acons 'z 'w nil))))
(defun closure-of-replacement-alist (alist)
  (closure-of-replacement-alist-aux alist alist))

;this isn't true rewriting... rename...
(defun rewrite-alist-vals (alist replacement-alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry))
           (val (cdr entry))
           (val (replace-in-term2 val replacement-alist)
                ))
      (acons-fast key val (rewrite-alist-vals (cdr alist) replacement-alist)))))

;; (defun make-replacement-equalities2 (alist)
;;   (if (endp alist)
;;       nil
;;     (cons `(equal ,(caar alist) ,(cdar alist))
;;           (make-replacement-equalities2 (cdr alist)))))

(defun make-connection-equalities3 (lhses rhses)
  (if (endp lhses)
      nil
    (cons `(equal ,(car lhses) ,(car rhses))
          (make-connection-equalities3 (cdr lhses) (cdr rhses)))))

(defun packnew-list (item lst state)
  (declare (xargs :guard (true-listp lst)
                  :stobjs state))
  (if (endp lst)
      nil
    (cons (packnew item (car lst))
          (packnew-list item (cdr lst) state))))

;test whether any key of param-component-replacement-alist is a call to nth on the formal
;fixme what about nth-of-nth?
(defun no-components-replaced (formal param-component-replacement-alist)
  (if (endp param-component-replacement-alist)
      t
    (let* ((entry (car param-component-replacement-alist))
           (key (car entry)))
      (if (and (consp key)
               (eq 'nth (ffn-symb key))
               (equal formal (second (fargs key))))
          nil
        (no-components-replaced formal (cdr param-component-replacement-alist))))))

;components are numbered starting at 0
(defun pair-kept-components-with-new-exprs (formal new-formal current-component-number current-new-component-number total-component-count param-component-replacement-alist acc)
  (declare (xargs :measure (+ 1 (nfix (- total-component-count current-component-number)))))
  (if (or (not (natp current-component-number))
          (not (natp total-component-count))
          (>= current-component-number total-component-count))
      acc
    (let* ((component-term `(nth ',current-component-number ,formal))
           (match (lookup-equal component-term param-component-replacement-alist)))
      (if match
          ;;this component is being replaced, so it is not a kept component
          (pair-kept-components-with-new-exprs formal new-formal
                                               (+ 1 current-component-number)
                                               current-new-component-number ;not incremented
                                               total-component-count param-component-replacement-alist acc)
        ;;this component is bring kept:
        (pair-kept-components-with-new-exprs formal new-formal
                                             (+ 1 current-component-number)
                                             (+ 1 current-new-component-number)
                                             total-component-count param-component-replacement-alist
                                             (acons-fast component-term `(nth ',current-new-component-number ,new-formal) acc))))))

;; ;fixme what about dropping of an entire formal? (here and elsewhere?)
;; (defun kept-component-renaming-alist (formals new-formals formal-length-alist component-replacement-alist acc)
;;   (if (endp formals)
;;       acc
;;     (let* ((formal (first formals))
;;            (new-formal (first new-formals)))
;;       (if (no-components-replaced formal component-replacement-alist)
;;           ;;no components of this formal are being replaced, so just pair it with its new name:
;;           (kept-component-renaming-alist (cdr formals) (cdr new-formals) formal-length-alist component-replacement-alist
;;                                          (acons formal new-formal acc))
;;         ;;some components of this formal are being replaced:
;;         (kept-component-renaming-alist (cdr formals) (cdr new-formals) formal-length-alist component-replacement-alist
;;                                        (pair-kept-components-with-new-exprs formal new-formal
;;                                                                             0
;;                                                                             0
;;                                                                             (lookup-eq formal formal-length-alist)
;;                                                                             component-replacement-alist
;;                                                                             acc))))))

(defun copy-vals-in-test-cases (test-cases formal new-formal acc)
  (if (endp test-cases)
      (reverse acc)
    (let* ((test-case (first test-cases))
           (val-for-formal (lookup-eq-safe formal test-case))
           (test-case (acons-fast new-formal val-for-formal test-case)))
      (copy-vals-in-test-cases (rest test-cases) formal new-formal (cons test-case acc)))))

(defun test-case-val-for-new-formal (formal new-formal current-component-number total-component-count param-component-replacement-alist val-for-formal)
  (declare (xargs :measure (+ 1 (nfix (- total-component-count current-component-number))))
           (irrelevant new-formal) ;todo
           )
  (if (or (not (natp current-component-number))
          (not (natp total-component-count))
          (>= current-component-number total-component-count))
      nil
    (let* ((component-term `(nth ',current-component-number ,formal))
           (match (lookup-equal component-term param-component-replacement-alist)))
      (if match
          ;;this component is being dropped:
          (test-case-val-for-new-formal formal new-formal
                                        (+ 1 current-component-number)
                                        total-component-count param-component-replacement-alist val-for-formal)
        ;;this component is bring kept:
        (cons (nth current-component-number val-for-formal)
              (test-case-val-for-new-formal formal new-formal
                                            (+ 1 current-component-number)
                                            total-component-count param-component-replacement-alist
                                            val-for-formal
                                            ))))))

;; (defun add-test-cases-for-partially-dropped-formal (test-cases formal new-formal formal-length param-component-replacement-alist acc)
;;   (if (endp test-cases)
;;       (reverse acc)
;;     (let* ((test-case (first test-cases))
;;            (val-for-formal (lookup-eq-safe formal test-case)))
;;       (add-test-cases-for-partially-dropped-formal (rest test-cases) formal new-formal formal-length param-component-replacement-alist
;;                                                    (cons (acons new-formal
;;                                                                 (test-case-val-for-new-formal formal new-formal 0 formal-length param-component-replacement-alist val-for-formal)
;;                                                                 test-case)
;;                                                          acc)))))

;; (add-test-cases-for-new-formals '(new-params) '(new-new-params) (acons 'new-params 7 nil)
;;                                 '(((NTH '0 NEW-PARAMS) QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)))
;;                                 '(((NEW-PARAMS (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;;                                                271733878 2562383102
;;                                                4023233417 1732584193 0 (74 175 99)))
;;                                   ((NEW-PARAMS (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;;                                                1 2 3 4 0 (74 175 99)))))

;; ;fixme what about the dropping of entire formals?
;; (defun add-test-cases-for-new-formals (formals new-formals formal-length-alist
;;                                                param-component-replacement-alist ;only need the keys of this?
;;                                                test-cases)
;;   (if (endp formals)
;;       test-cases
;;     (let* ((formal (first formals))
;;            (new-formal (first new-formals)))
;;       (if (no-components-replaced formal param-component-replacement-alist)
;;           ;can we unify these two branches?
;;           ;;no components of this formal are being replaced, so its test case is the same as the one for formal
;;           (add-test-cases-for-new-formals (cdr formals) (cdr new-formals) formal-length-alist param-component-replacement-alist
;;                                           (copy-vals-in-test-cases test-cases formal new-formal nil)
;;                                           )
;;         ;;some components of this formal are being replaced:
;;         (add-test-cases-for-new-formals (cdr formals) (cdr new-formals) formal-length-alist param-component-replacement-alist
;;                                         (add-test-cases-for-partially-dropped-formal test-cases
;;                                                                                      formal new-formal (lookup-eq formal formal-length-alist)
;;                                                                                      param-component-replacement-alist
;;                                                                                      nil))))))

(defun dropped-component-renaming-alist (param-component-replacement-alist kept-component-renaming-alist acc)
  (if (endp param-component-replacement-alist)
      acc
    (let* ((entry (car param-component-replacement-alist))
           (component-to-drop (car entry))
           (explanation (cdr entry)) ;in terms of the old params (but only the kept ones)
           (new-explanation (replace-in-term2 explanation kept-component-renaming-alist)) ;in terms of the new formals
           )
      (dropped-component-renaming-alist (cdr param-component-replacement-alist) kept-component-renaming-alist
                                        (acons-fast component-to-drop new-explanation acc)))))

;; ;every component has a match in one of the 2 alists
;; (defun formal-replacement-term-components (formal current-component-number total-component-count kept-component-renaming-alist dropped-component-renaming-alist)
;;   (declare (xargs :measure (+ 1 (nfix (- total-component-count current-component-number)))
;;                   :hints (("Goal" :in-theory (enable natp)))
;;                   ))
;;   (if (or (not (natp current-component-number))
;;           (not (natp total-component-count))
;;           (>= current-component-number total-component-count))
;;       nil
;;     (let* ((component-term `(nth ',current-component-number ,formal))
;;            (match (lookup-equal component-term kept-component-renaming-alist)))
;;       (if match
;;           (cons match (formal-replacement-term-components formal (+ 1 current-component-number) total-component-count kept-component-renaming-alist dropped-component-renaming-alist))
;;         (cons (lookup-equal component-term dropped-component-renaming-alist)
;;               (formal-replacement-term-components formal (+ 1 current-component-number) total-component-count kept-component-renaming-alist dropped-component-renaming-alist))))))

;; (defun formal-replacement-terms (formals formal-length-alist kept-component-renaming-alist dropped-component-renaming-alist)
;;   (if (endp formals)
;;       nil
;;     (let* ((formal (car formals))
;;            (match (lookup-equal formal kept-component-renaming-alist)))
;;       ;what if the whole formal is dropped?
;;       (if match
;;           ;;we have an expression for the whole parameter:
;;           (cons match (formal-replacement-terms (cdr formals) formal-length-alist kept-component-renaming-alist dropped-component-renaming-alist))
;;         ;we have to handle the pieces
;;         (cons (make-cons-nest (formal-replacement-term-components formal 0 (lookup-eq formal formal-length-alist) kept-component-renaming-alist dropped-component-renaming-alist))
;;               (formal-replacement-terms (cdr formals) formal-length-alist kept-component-renaming-alist dropped-component-renaming-alist))))))

(defun new-update-expr-components (component-num highest-component-num new-formal new-update-expr new-components-in-terms-of-old-alist)
  (declare (xargs :measure (nfix (+ 1 (- (nfix highest-component-num) (nfix component-num))))
                  :hints (("Goal" :in-theory (enable natp)))))
  (if (or (not (natp component-num))
          (not (natp highest-component-num))
          (> component-num highest-component-num))
      nil
    (let* ((this-component-expr `(nth ',component-num ,new-formal))
           ;this should be a call to nth:
           (this-component-in-terms-of-old-formals (lookup-equal this-component-expr new-components-in-terms-of-old-alist))
           (old-component-num (safe-unquote (first (fargs this-component-in-terms-of-old-formals))))
           ;(fixed-up-expr (sublis-var-simple formal-replacement-alist this-component-in-terms-of-old-formals))
           )
      (cons `(nth ',old-component-num ,new-update-expr)
            (new-update-expr-components (+ 1 component-num)
                                        highest-component-num new-formal new-update-expr new-components-in-terms-of-old-alist)))))

(defun find-highest-numbered-component-key (alist formal highest-so-far)
  (if (endp alist)
      highest-so-far
    (let* ((entry (car alist))
           (key (car entry)))
      (if (and (call-of 'nth key)
               (eq formal (second (fargs key)))
               (quotep (first (fargs key)))
               (< highest-so-far (unquote (first (fargs key)))))
          (find-highest-numbered-component-key (cdr alist) formal (unquote (first (fargs key))))
        (find-highest-numbered-component-key (cdr alist) formal highest-so-far)))))


(defun cons-all-onto (vals tail)
  (if (endp vals)
      nil
      (cons (cons (car vals) tail)
            (cons-all-onto (cdr vals) tail))))

(defun lookup-formal-components (component-num highest-component-num new-formal new-components-in-terms-of-old-alist)
  (declare (xargs :measure (nfix (+ 1 (- (nfix highest-component-num) (nfix component-num))))
                  :hints (("Goal" :in-theory (enable natp)))))
  (if (or (not (natp component-num))
          (not (natp highest-component-num))
          (> component-num highest-component-num))
      nil
    (let ((this-component-expr `(nth ',component-num ,new-formal)))
      (cons (lookup-equal-safe this-component-expr new-components-in-terms-of-old-alist)
            (lookup-formal-components (+ 1 component-num)
                                      highest-component-num new-formal new-components-in-terms-of-old-alist)))))

(defun express-new-params-in-terms-of-old (new-formals new-components-in-terms-of-old-alist)
  (if (endp new-formals)
      nil
    (cons (let* ((new-formal (car new-formals))
                 (highest-numbered-component (find-highest-numbered-component-key new-components-in-terms-of-old-alist new-formal 0)))
            (make-cons-nest (lookup-formal-components 0 highest-numbered-component new-formal new-components-in-terms-of-old-alist)))
          (express-new-params-in-terms-of-old (cdr new-formals) new-components-in-terms-of-old-alist))))

(defun nth-nest-with-corep (core nest)
  (if (equal core nest)
      t
    (if (not (call-of 'nth nest)) ;check that the arg to nth is a quotep?
        nil
      (nth-nest-with-corep core (farg2 nest)))))

(defun some-components-replacedp (item component-replacement-alist)
  (if (endp component-replacement-alist)
      nil
    (let* ((entry (car component-replacement-alist))
           (key (car entry)))
      (if (nth-nest-with-corep item key)
          t
        (some-components-replacedp item (cdr component-replacement-alist))))))

(skip-proofs
 (mutual-recursion
  (defun all-components-replacedp (item shape component-replacement-alist)
    (let ((whole-thing-replacedp (assoc-equal item component-replacement-alist)))
      (if whole-thing-replacedp
          t
        (if (not (call-of :tuple shape)) ;fixme tuples here include arrays and sequences?
            ;;it's not a tuple, and the whole thing isn't to be replaced:
            nil
          ;;it is a tuple, and the whole thing isn't to be replaced, so check whether every component is replaced:
          (let ((component-shapes (fargs shape))) ;strip off the :tuple
            (all-components-replaced-lstp (make-nth-terms (len component-shapes) item)
                                          component-shapes
                                          component-replacement-alist))))))

  (defun all-components-replaced-lstp (items shapes component-replacement-alist)
    (if (endp items)
        t
      (and (all-components-replacedp (first items) (first shapes) component-replacement-alist)
           (all-components-replaced-lstp (rest items) (rest shapes) component-replacement-alist))))))

(skip-proofs
 (mutual-recursion
  ;;extends acc with entries to rename all kept components of item
  ;;we've already renamed item, but maybe its components will also need to be renamed:
  (defun add-renamings-of-kept-components (item renamed-item shape component-replacement-alist acc)
    (declare (xargs :measure 10))
    (if (not (call-of :tuple shape)) ;(we should not be instructed to replace any components if it's not a tuple) fixme tuples here include arrays and sequences?
        ;;keep the whole ITEM:
        (acons-fast item renamed-item acc)
      ;;it is a tuple:
      (if (not (some-components-replacedp item component-replacement-alist))
          ;;keep the whole ITEM:
          (acons-fast item renamed-item acc)
        ;;some component is being replaced:
        (add-renamings-of-kept-components-lst item
                                              renamed-item
                                              0
                                              0
                                              (fargs shape) ;strips off the symbol :tuple
                                              component-replacement-alist acc))))

  (defun add-renamings-of-kept-components-lst (item ;the item whose nths we are dealing with
                                               renamed-item
                                               old-component-num new-component-num shapes component-replacement-alist acc)
    (declare (xargs :measure (acl2-count shapes)))
    (if (endp shapes)
        acc
      (let* ((term `(nth ',old-component-num ,item))
             (shape (first shapes)))
        (if (all-components-replacedp term shape component-replacement-alist) ;(lookup-equal term component-replacement-alist) ;Tue Sep 21 15:10:47 2010
            ;;the whole item is to be replaced (so no part of it is kept):
            (add-renamings-of-kept-components-lst item renamed-item (+ 1 old-component-num)
                                                  new-component-num ;not incremented
                                                  (rest shapes) component-replacement-alist acc)
          ;;at least part of the TERM is to be kept:
          (let ((acc (add-renamings-of-kept-components term `(nth ',new-component-num ,renamed-item)
                                                       (first shapes) component-replacement-alist acc)))
            (add-renamings-of-kept-components-lst item renamed-item (+ 1 old-component-num)
                                                  (+ 1 new-component-num) ;incremented because we kept (some part of) TERM
                                                  (rest shapes) component-replacement-alist acc))))))))

;example call:
;; (kept-component-renaming-alist2 '(params)
;;                                 '(new-params)
;;                                 '((PARAMS :TUPLE
;;                                           ITEM ITEM ITEM ITEM ITEM ITEM ITEM ITEM
;;                                           (:TUPLE ITEM
;;                                                   ITEM ITEM ITEM ITEM ITEM ITEM ITEM)))
;;                                 '(((NTH '7 PARAMS) QUOTE 8)
;;                                   ((NTH '6 PARAMS) QUOTE :BYTE)
;;                                   ((NTH '5 PARAMS) QUOTE :BYTE)
;;                                   ((NTH '3 PARAMS)
;;                                    SLICE '2
;;                                    '0
;;                                    (NTH '1 PARAMS))) nil)

;ffixme what about dropping entire formals (here and elsewhere)?
;ffffixme ;this could return an alist from new-formals that are not dropped to their expressions in terms of the old formals..
(defun kept-component-renaming-alist2 (formals new-formals formal-shape-alist component-replacement-alist acc)
  (if (endp formals)
      acc
    (let* ((formal (first formals))
           (new-formal (first new-formals))
           (replacement-for-formal (lookup-eq formal component-replacement-alist))) ;ffffixme what if every branch of the tree gets replaced?
      (if replacement-for-formal
          ;;the whole formal is to be replaced, so none of it is kept:
          (kept-component-renaming-alist2 (rest formals) (rest new-formals) formal-shape-alist component-replacement-alist acc)
        (kept-component-renaming-alist2 (rest formals) (rest new-formals) formal-shape-alist component-replacement-alist
                                        (add-renamings-of-kept-components formal
                                                                          new-formal
                                                                          (lookup-eq-safe formal formal-shape-alist)
                                                                          component-replacement-alist
                                                                          acc))))))

(skip-proofs
 (mutual-recursion
  (defun replacement-term-lst (terms shapes kept-component-renaming-alist dropped-component-renaming-alist)
    (if (endp terms)
        nil
      (cons (replacement-term (first terms) (first shapes) kept-component-renaming-alist dropped-component-renaming-alist)
            (replacement-term-lst (rest terms) (rest shapes) kept-component-renaming-alist dropped-component-renaming-alist))))

  (defun replacement-term (term shape kept-component-renaming-alist dropped-component-renaming-alist)
    (or (lookup-equal term kept-component-renaming-alist) ;if we are keeping the whole thing
        (lookup-equal term dropped-component-renaming-alist) ;if we are dropping the whole thing ;Tue Sep 21 16:26:09 2010
        ;(all-components-replacedp term shape dropped-component-renaming-alist) ;ffffixme what if we are dropping each component?
        ;;otherwise, we must handle the components (i guess we are keeping some and dropping others)
        (if (not (call-of :tuple shape))
            (hard-error 'replacement-term "expected a tuple shape for ~x0" (acons #\0 term nil))
          (let* ((args-shapes (fargs shape))
                 (len (len args-shapes)))
            (make-cons-nest (replacement-term-lst (make-nth-terms len term)
                                                  args-shapes
                                                  kept-component-renaming-alist dropped-component-renaming-alist))))))))

;; (formal-replacement-terms2 '(params)
;;                            '((params :TUPLE ITEM ITEM ITEM ITEM ITEM ITEM ITEM ITEM))
;;                            '(((NTH '8 PARAMS) NTH '4 NEW-PARAMS)
;;                              ((NTH '4 PARAMS) NTH '3 NEW-PARAMS)
;;                              ((NTH '2 PARAMS) NTH '2 NEW-PARAMS)
;;                              ((NTH '1 PARAMS) NTH '1 NEW-PARAMS)
;;                              ((NTH '0 PARAMS) NTH '0 NEW-PARAMS))
;;                            '(((NTH '3 PARAMS)
;;                               SLICE '2
;;                               '0
;;                               (NTH '1 NEW-PARAMS))
;;                              ((NTH '5 PARAMS) QUOTE :BYTE)
;;                              ((NTH '6 PARAMS) QUOTE :BYTE)
;;                              ((NTH '7 PARAMS) QUOTE 8)))

(defun formal-replacement-terms2 (formals formal-shape-alist kept-component-renaming-alist dropped-component-renaming-alist)
  (if (endp formals)
      nil
    (let* ((formal (first formals)))
      (cons (replacement-term formal (lookup-eq-safe formal formal-shape-alist) kept-component-renaming-alist dropped-component-renaming-alist)
            (formal-replacement-terms2 (rest formals) formal-shape-alist kept-component-renaming-alist dropped-component-renaming-alist)))))

(skip-proofs
 (mutual-recursion
  ;;we've already renamed item, but maybe its components will also need to be renamed:
  (defun component-in-terms-of-old (item renamed-item shape component-replacement-alist)
    (declare (xargs :measure 10)
             (irrelevant renamed-item)) ;todo
    (if (not (call-of :tuple shape)) ;(we should not be instructed to replace any components if it's not a tuple)
        ;;keep the whole ITEM:
        item
      ;;it is a tuple:
      (if (not (some-components-replacedp item component-replacement-alist))
          ;;keep the whole ITEM:
          item
        ;;some component is being replaced:
        (make-cons-nest (component-in-terms-of-old-lst item
                                                       renamed-item
                                                       0
                                                       0
                                                       (fargs shape) ;strips off the symbol :tuple
                                                       component-replacement-alist)))))

  (defun component-in-terms-of-old-lst (item ;the item whose nths we are dealing with
                                        renamed-item
                                        old-component-num new-component-num shapes component-replacement-alist)
    (declare (xargs :measure (acl2-count shapes))
             (irrelevant renamed-item new-component-num))
    (if (endp shapes)
        nil
      (let* ((term `(nth ',old-component-num ,item))
             (shape (first shapes)))
        (if (all-components-replacedp term shape component-replacement-alist) ; Tue Sep 21 16:46:03 2010 (lookup-equal term component-replacement-alist)
            ;;the whole item is to be replaced (so no part of it is kept):
            (component-in-terms-of-old-lst item renamed-item (+ 1 old-component-num)
                                           new-component-num ;not incremented
                                           (rest shapes) component-replacement-alist)
          ;;at least part of the TERM is to be kept:
          (cons (component-in-terms-of-old term `(nth ',new-component-num ,renamed-item) shape component-replacement-alist)
                (component-in-terms-of-old-lst item renamed-item (+ 1 old-component-num)
                                               (+ 1 new-component-num) ;incremented because we kept (some part of) TERM
                                               (rest shapes) component-replacement-alist))))))))

;; example:
;; (new-formals-in-terms-of-old-alist '(params)
;;                                    '(new-params)
;;                                    '((PARAMS :TUPLE
;;                                              ITEM ITEM ITEM ITEM ITEM ITEM ITEM ITEM
;;                                              (:TUPLE ITEM
;;                                                      ITEM ITEM ITEM ITEM ITEM ITEM ITEM)))
;;                                    '(((NTH '7 PARAMS) QUOTE 8)
;;                                      ((NTH '6 PARAMS) QUOTE :BYTE)
;;                                      ((NTH '5 PARAMS) QUOTE :BYTE)
;;                                      ((NTH '3 PARAMS)
;;                                       SLICE '2
;;                                       '0
;;                                       (NTH '1 PARAMS))) nil)

;some formals may be dropped completely
(defun new-formals-in-terms-of-old-alist (formals new-formals formal-shape-alist component-replacement-alist acc)
  (if (endp formals)
      acc ;reverse this?
    (let* ((formal (first formals))
           (new-formal (first new-formals))
           (replacement-for-formal (lookup-eq formal component-replacement-alist))) ;fixme what if each component is to be replaced?
      (if replacement-for-formal
          ;;the whole formal is to be replaced, so none of it is kept:
          (new-formals-in-terms-of-old-alist (rest formals) (rest new-formals) formal-shape-alist component-replacement-alist acc)
        (new-formals-in-terms-of-old-alist (rest formals) (rest new-formals) formal-shape-alist component-replacement-alist
                                           (acons-fast new-formal (component-in-terms-of-old formal
                                                                                             new-formal
                                                                                             (lookup-eq-safe formal formal-shape-alist)
                                                                                             component-replacement-alist)
                                                       acc))))))

(defun eval-cons-and-nth-nest (term alist)
  (if (quotep term)
      (unquote term)
    (if (variablep term)
        (lookup-eq-safe term alist)
      (if (call-of 'cons term)
          (cons (eval-cons-and-nth-nest (farg1 term) alist)
                (eval-cons-and-nth-nest (farg2 term) alist))
        (if (call-of 'nth term)
            (nth (eval-cons-and-nth-nest (farg1 term) alist)
                 (eval-cons-and-nth-nest (farg2 term) alist))
          (hard-error 'eval-cons-and-nth-nest "unexpected thing: ~x0." (acons #\0 term nil)))))))

;one iteration for each new formal
(defun extend-test-case-for-new-formals (new-formals-in-terms-of-old-alist test-case)
  (if (endp new-formals-in-terms-of-old-alist)
      test-case
    (let* ((entry (car new-formals-in-terms-of-old-alist))
           (new-formal (car entry))
           (expr (cdr entry))
           (val (eval-cons-and-nth-nest expr test-case))
           )
      (extend-test-case-for-new-formals (cdr new-formals-in-terms-of-old-alist)
                                        (acons-fast new-formal
                                               val
                                               test-case)))))

;; example:
;; (add-test-cases-for-new-formals2 (acons 'new-params '(cons (nth '0 params) (cons (nth '2 params) (cons (nth '6 params) 'nil))) nil)
;;                                 '(((PARAMS (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;;                                                271733878 2562383102
;;                                                4023233417 1732584193 0 (74 175 99)))
;;                                   ((PARAMS (0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
;;                                                1 2 3 4 0 (74 175 99)))))

;the cdrs of new-formals-in-terms-of-old-alist are nests of cons and nth and old formals (which have values in test-cases)
(defun add-test-cases-for-new-formals2 (new-formals-in-terms-of-old-alist test-cases acc)
  (if (endp test-cases)
      (reverse acc) ;drop the reverse?
    (add-test-cases-for-new-formals2 new-formals-in-terms-of-old-alist (rest test-cases)
                                     (cons (extend-test-case-for-new-formals new-formals-in-terms-of-old-alist (first test-cases))
                                           acc))))

(defun filter-user-fns-to-open (fns i-fns)
  (if (endp fns)
      nil
    (let ((fn (first fns)))
      (if (and (not (member-eq fn *built-in-fns*))
               (member-eq fn (strip-cars i-fns)) ;slow?
               )
          (cons fn (filter-user-fns-to-open (rest fns) i-fns))
        (filter-user-fns-to-open (rest fns) i-fns)))))

;example:
;; (make-new-update-exprs2 '(new-params)
;;                         '((NEW-PARAMS
;;                            CONS (NTH '2 PARAMS)
;;                            (CONS (NTH '4 PARAMS)
;;                                  (CONS (NTH '5 PARAMS)
;;                                        (CONS (NTH '6 PARAMS)
;;                                              (CONS (NTH '7 PARAMS)
;;                                                    (CONS (NTH '8 PARAMS)
;;                                                          (CONS (NTH '9 PARAMS)
;;                                                                (CONS (NTH '13 PARAMS) 'NIL)))))))))
;;                         '((PARAMS
;;                            CONS
;;                            (BVMINUS '32
;;                                     (LEN (NTH '7 NEW-PARAMS))
;;                                     (NTH '6 NEW-PARAMS))
;;                            (CONS
;;                             (NTH '6 NEW-PARAMS)
;;                             (CONS
;;                              (NTH '0 NEW-PARAMS)
;;                              (CONS
;;                               (SLICE '5 '2 (NTH '6 NEW-PARAMS))
;;                               (CONS
;;                                (NTH '1 NEW-PARAMS)
;;                                (CONS
;;                                 (NTH '2 NEW-PARAMS)
;;                                 (CONS (NTH '3 NEW-PARAMS)
;;                                       (CONS (NTH '4 NEW-PARAMS)
;;                                             (CONS (NTH '5 NEW-PARAMS)
;;                                                   (CONS (NTH '6 NEW-PARAMS)
;;                                                         (CONS '4
;;                                                               (CONS ':BYTE
;;                                                                     (CONS (LEN (NTH '7 NEW-PARAMS))
;;                                                                           (CONS (NTH '7 NEW-PARAMS)
;;                                                                                 'NIL)))))))))))))))
;;                         '((PARAMS SHA1-LOOP-10-UPDATE PARAMS))
;;                         *i-fns*
;;                         state)

(defun convert-to-head-recursive-events-wrapper (original-function-name state)
  (declare (xargs :guard (symbolp original-function-name)
                  :stobjs state))
  (convert-to-head-recursive-events original-function-name
                                    (packnew original-function-name '-exit-test)
                                    (packnew original-function-name '-measure)
                                    (packnew original-function-name '-update)
                                    (packnew original-function-name '-base)
                                    nil ;; reps-hints
                                    ))

;this one doesn't return ground-termp
(defun sublis-var-and-eval-lst2 (alist l interpreted-function-alist)
  (mv-let (ground-termp result)
          (sublis-var-and-eval-lst alist l interpreted-function-alist)
          (declare (ignore ground-termp))
          result))

(defun skip-len (nodenum dag-array-name dag-array)
  (let* ((expr (aref1 dag-array-name dag-array nodenum)))
    (if (or (not (consp expr))
            (not (eq 'len (ffn-symb expr)))
            (quotep (first (fargs expr))) ;shouldn't happen
            )
        nodenum
      ;it is a call to len:
      (first (fargs expr)))))

;; (def-typed-acl2-array2 fns-arrayp (symbol-listp val))

;; (local (include-book "kestrel/typed-lists-light/symbol-listp" :dir :system))

;; (local (in-theory (enable true-listp-when-symbol-listp)))

;; (local
;;   (defthm true-listp-when-symbol-listp-rewrite ; todo: add to lib
;;     (implies (symbol-listp x)
;;              (true-listp x))))

;; ;items are nodenums, quoteps, or array-names
;; (defun get-fns-of-items (items fns-array)
;;   (declare (xargs :guard (and (fns-arrayp 'fns-array fns-array)
;;                               (bounded-darg-listp items (alen1 'fns-array fns-array)))))
;;   (if (endp items)
;;       nil
;;     (let* ((item (car items)))
;;       (if (or (symbolp item)
;;               (quotep item))
;;           (get-fns-of-items (cdr items) fns-array)
;;         (union-eq (aref1 'fns-array fns-array item)
;;                   (get-fns-of-items (cdr items) fns-array))))))

;; (local
;;   (defthm symbol-listp-of-get-fns-of-items
;;     (implies (and (fns-arrayp 'fns-array fns-array)
;;                   (bounded-darg-listp items (alen1 'fns-array fns-array)))
;;              (symbol-listp (get-fns-of-items items fns-array)))
;;     :hints (("Goal" :in-theory (enable get-fns-of-items)))))

;; ;pairs each nodenum with a list of the fns that support it
;; (defund make-fns-array-for-nodes (n max-nodenum dag-array-name dag-array fns-array)
;;   (declare (xargs :guard (and (natp n)
;;                               (natp max-nodenum)
;;                               (pseudo-dag-arrayp dag-array-name dag-array (+ 1 max-nodenum))
;;                               (fns-arrayp 'fns-array fns-array)
;;                               (< max-nodenum (alen1 'fns-array fns-array)))
;;                   :guard-hints (("Goal" :in-theory (enable <-of-+-of-1-when-integerp)))
;;                   :measure (+ 1 (nfix (- (+ 1 max-nodenum) n)))))
;;   (if (or (not (natp n))
;;           (not (natp max-nodenum))
;;           (> n max-nodenum))
;;       fns-array
;;     (let ((expr (aref1 dag-array-name dag-array n)))
;;       (if (or (symbolp expr)
;;               (quotep expr))
;;           ;;no funs for this node, so we leave the default value (nil) in the array:
;;           (make-fns-array-for-nodes (+ 1 n) max-nodenum dag-array-name dag-array fns-array)
;;         (make-fns-array-for-nodes (+ 1 n) max-nodenum dag-array-name dag-array
;;                                   (aset1-safe 'fns-array fns-array n (add-to-set-eq (ffn-symb expr)
;;                                                                                     (get-fns-of-items (dargs expr) fns-array))))))))

;; (local
;;   (defthm make-fns-array-for-nodes-return-type
;;     (implies (and (natp n)
;;                    (natp max-nodenum)
;;                    (pseudo-dag-arrayp dag-array-name dag-array (+ 1 max-nodenum))
;;                    (fns-arrayp 'fns-array fns-array)
;;                    (< max-nodenum (alen1 'fns-array fns-array)))
;;               (and (array1p 'fns-array (make-fns-array-for-nodes n max-nodenum dag-array-name dag-array fns-array))
;;                    (equal (alen1 'fns-array (make-fns-array-for-nodes n max-nodenum dag-array-name dag-array fns-array))
;;                           (alen1 'fns-array fns-array))))
;;     :hints (("Goal" :induct t
;;              :in-theory (enable make-fns-array-for-nodes)))))

;; (defund fns-that-support-node (nodenum dag-array-name dag-array)
;;   (declare (xargs :guard (and (natp nodenum)
;;                               (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum)))))
;;   (let* ((fns-array (new-array1 'fns-array (+ 1 nodenum)))
;;          ;;this makes the fns-array for all nodes.  could just do it for supporters, but that might be slower if most nodes are supporters
;;          (fns-array (make-fns-array-for-nodes 0 nodenum dag-array-name dag-array fns-array)))
;;     (aref1 'fns-array fns-array nodenum)))

(defun assert-non-nil (tag item)
  (if (equal nil item)
      (hard-error 'assert-non-nil "~x0 cannot be nil." (acons #\0 tag nil))
    item))

(defun sub1-list (nums)
  (if (endp nums)
      nil
    (cons (+ -1 (car nums))
          (sub1-list (cdr nums)))))

;looks for an equality that rewrites one of the LHSes to anything involving target
(defun some-element-rewrites-to-target (lhses target terms)
  (if (endp terms)
      nil
    (let ((term (first terms)))
      (if (and ;;(intersection-equal lhses (get-mentioned-arg-lhses-aux2 (farg1 term)))
             (call-of 'equal term)
             (member-equal (farg1 term) lhses)
             (subtermp target (farg2 term)))
          t
        (some-element-rewrites-to-target lhses target (rest terms))))))

;fixme what about len ?
;does not include quoteps
(mutual-recursion
 (defun get-subterms (term)
   (if (atom term)
       (list term)
     (if (quotep term)
         nil
       (cons term
             (get-subterms-lst (fargs term))))))

 (defun get-subterms-lst (terms)
   (if (endp terms)
       nil
     (append (get-subterms (car terms))
             (get-subterms-lst (cdr terms))))))

;returns a subset of terms
;is this too draconian?
;what if we would prefer to keep some of the connections in terms-to-check?
;fixme try rewriting each connection with the others and drop any resulting t's?
;this routine can fail to remove all loops if any equalities among params of a single function survive the dropping step (maybe because old vars are involved)?
(defun remove-connections-that-might-loop (terms terms-to-check)
  (if (endp terms)
      nil
    (let ((term (first terms)))
      (if (or (not (call-of 'equal term))
              ;(not (member-equal `(equal ,(farg2 term) ,(farg1 term)) terms-to-check))
              ;;no component in the rhs appears in the lhs of a connction that might go the other way - this dropped too much
              (not (some-element-rewrites-to-target (get-subterms (farg2 term)) (farg1 term) terms-to-check))
              )
          (cons term
                (remove-connections-that-might-loop (rest terms) terms-to-check))
        (prog2$ (cw "Dropping connection ~x0 to prevent loops.~%" term)
                (remove-connections-that-might-loop (rest terms) terms-to-check))))))

;; ;make this a macro?
;; (defun droplast (lst)
;;   (butlast lst 1))

;; (defmap-simple droplast)





;; ;tail-recursive (we don't bother to reverse the acc)
;; (defun strip-cdrs-and-rev (lst acc)
;;   (if (endp lst)
;;       acc
;;     (strip-cdrs-and-rev (cdr lst) (cons (cdr (car lst)) acc))))

;; ;each pair in the resulting alist pairs a value with the list of nodenums that have the value under the current test case
;; ;BOZO speed this up.
;; (defun make-full-dag-val-alist (n dag-len test-case-array acc test-case-array-name)
;;   (declare (xargs :verify-guards nil
;;                   :measure (+ 1 (nfix (- dag-len n)))))
;;   (if (or (>= n dag-len)
;;           (not (natp n))
;;           (not (natp dag-len)))
;;       acc
;;     (let* ((val (aref1 test-case-array-name test-case-array n))
;;            (val-nodenums (lookup-equal val acc)))
;;       (make-full-dag-val-alist (+ 1 n) dag-len test-case-array (acons-fast val (cons n val-nodenums) acc)
;;                                test-case-array-name))))



;; ;test-case-array maps nodenums 0..(1 - dag-len) to their values for the current test case
;; (defun initial-probably-equal-node-sets (dag-len test-case-array test-case-array-name)
;;   (let* ((alist (make-full-dag-val-alist 0 dag-len test-case-array nil test-case-array-name))) ;bozo faster to sort instead
;;     (drop-and-count-singletons (strip-cdrs-unique alist nil nil) nil 0)))



;; (defun split-node-set-into-pairs-aux (node-set acc)
;;   (if (or (endp node-set)
;;           (endp (cdr node-set)))
;;       'error
;;     (if (endp (cdr (cdr node-set)))
;;         (cons node-set acc)
;;       (let ((pair (list (car node-set) (cadr node-set))))
;;         (split-node-set-into-pairs-aux (cdr node-set) (cons pair acc))))))

;; ;will node-set come in reverse sorted?
;; ;node-set should have at least two elements?
;; (defun split-node-set-into-pairs (node-set)
;;   (let ((sorted-node-set (merge-sort-< node-set)))
;;     (split-node-set-into-pairs-aux sorted-node-set nil)))

;; (defun split-node-sets-into-pairs (node-sets acc)
;;   (if (endp node-sets)
;;       (reverse acc) ;can we skip this?
;;     (let* ((set (car node-sets))
;;            (pairs (split-node-set-into-pairs set)))
;;       (split-node-sets-into-pairs (cdr node-sets) (append pairs acc)))))

;; ;newly tail recursive
;; (defun remove-constant-sets (probably-equal-node-sets probably-constant-node-alist acc)
;;   (if (endp probably-equal-node-sets)
;;       (reverse acc) ;drop the reverse?
;;     (let* ((set (car probably-equal-node-sets))
;;            (node (first set)))
;;       (remove-constant-sets (cdr probably-equal-node-sets) probably-constant-node-alist
;;                             ;;omit sets which are probable constants:
;;                             (if (assoc node probably-constant-node-alist)
;;                                 acc ;drop this set (all nodes are probably equal to the same constant)
;;                               (cons set acc))))))

;; (defun make-formal-len-alist (formals term-traces-alist)
;;   (if (endp formals)
;;       nil
;;     (let* ((formal (car formals))
;;            (traces (lookup-eq formal term-traces-alist))
;;            (first-trace (first traces))
;;            (first-value (first first-trace)))
;;       (acons formal (len first-value) (make-formal-len-alist (cdr formals) term-traces-alist)))))

;returns (mv actual-name state)
;fixme allow no skip- proofs

;fixme what if the functions differ only on normalize nil? or defun mode?  or some other thing?
(defun make-defun (desired-name formals body state)
  (declare (xargs :stobjs state
                  :mode :program ;because this calls submit-event
                  ))
  (let* ((props (getprops desired-name 'current-acl2-world (w state)))
         (exitsting-body (lookup-eq 'unnormalized-body props))) ;fixme use the defbodies instead?
    (if (equal exitsting-body body) ;fixme consider macroexpansion...
        (prog2$ (cw "Reusing pre-existing defun ~x0.~%" desired-name)
                (mv desired-name state))
      (let* ((actual-name (packnew desired-name))
             (state (submit-event-brief `(skip-proofs (defun ,actual-name ,formals (declare (xargs :normalize nil)) ,body)) state))) ;fixme what about the otf-flg?
        (mv actual-name state)))))

;returns (mv new-fn-name alias-lemma-name alias-base-case-lemma-name state)
(defun make-alias-for-tail-function (fn ;the name of the function we're making an alias of
                                     formals
                                     exit-test-expr
                                     base-case-expr
                                     update-expr-list ;the expressions passed as arguments to the recursive call
                                     new-fn           ; a symbol
                                     wrap-base-case-hyp-in-work-hardp
                                     state)
  (declare (xargs :mode :program  ;because this calls submit-events-brief
                  :stobjs state))
  (let* ((equivalence-lemma-name (packnew fn '-becomes- new-fn))
         (alias-base-case-lemma-name (packnew new-fn '-base-case)))
    (mv-let (new-fn state)
            (make-defun new-fn
                        formals
                        `(if ,exit-test-expr
                             ,base-case-expr
                           (,new-fn ,@update-expr-list))
                        state)
            (let* ((state (submit-events-brief `((defthm ,equivalence-lemma-name
                                             (equal (,fn ,@formals)
                                                    (,new-fn ,@formals))
                                             :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                        '(,fn ,new-fn)))))

                                           ;;fffixme think about the work-hard - we want it for the complete unrolling (then the alias should never execute) but not for just plain splitting..
                                           (defthm ,alias-base-case-lemma-name
                                             (implies ,(if wrap-base-case-hyp-in-work-hardp `(work-hard ,exit-test-expr) exit-test-expr)
                                                      (equal (,new-fn ,@formals)
                                                             ,base-case-expr))
                                             :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                        '(work-hard ,new-fn))))))
                                         state)))
              (mv new-fn equivalence-lemma-name alias-base-case-lemma-name state)))))

;;(make-alias-for-tail-function 'sha1-loop-10 '(params) '(SHA1-LOOP-10-EXIT-TEST PARAMS) 'PARAMS '( (SHA1-LOOP-10-UPDATE PARAMS)) 'sha1-loop-10-alias nil state)

;makes the limited version of the function and proves that calling it before the regular function is the same as just calling the regular function
;;returns (mv split-lemma-helper-name base-case-lemma-name state)
(defun split-tail-function-helper (fn
                                   limited-fn ;the name of the function that does the first few iterations
                                   formals reps-formal exit-test-expr
                                   ;;base-case-expr
                                   update-expr-list ;the expressions passed as arguments to the recursive call
                                   state)
  (declare (xargs :mode :program ; because this calls submit-events-brief
                  :stobjs state))
  (let* ((arity (len formals)) ;pass in?
         (split-lemma-helper-name (packnew fn '-split-lemma-helper))
         (base-case-lemma-name (packnew limited-fn '-base-case))
         (limited-fn-body `(if (boolor ,exit-test-expr ;had or here, but that led to problems in the unroller rule
                                       (zp ,reps-formal))
                               ;;no base-case computation (just returns all the formals):
                               (list ,@formals)
                             (,limited-fn ,@update-expr-list (+ -1 ,reps-formal))))
         (state (submit-events-brief `((skip-proofs
                                  (defun ,limited-fn (,@formals ,reps-formal)
                                    (declare (xargs :normalize nil)) ;may be crucial?
                                    ,limited-fn-body))

                                 (defthm ,base-case-lemma-name
                                   (implies (and (syntaxp (quotep ,reps-formal))
                                                 (zp ,reps-formal))
                                            (equal (,limited-fn ,@formals ,reps-formal)
                                                   (list ,@formals)))
                                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                              '(,limited-fn zp boolor)))))

                                 ;; ;make separate rules for the unrolling and base cases?!
                                 ;; (defthm ,unroller-lemma-name
                                 ;;   (implies (and (syntaxp (quotep ,reps-formal))
                                 ;;                 (< reps 100));fixme what if there is a case where reps is huge?!
                                 ;;            (equal (,limited-fn ,@formals ,reps-formal)
                                 ;;                   ,limited-fn-body))
                                 ;;   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                 ;;                                              '(,limited-fn)))))

;this will be converted to use the alias function
                                 (defthm ,split-lemma-helper-name
                                   (equal (,fn ,@formals)
                                          (let ((limited-result (,limited-fn ,@formals ,reps-formal)))
                                            (,fn ,@(make-nth-terms arity 'limited-result))))
                                   :rule-classes nil
                                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                              '(,fn ,limited-fn nth-of-cons zp boolor))))))
                               state)))
    (mv split-lemma-helper-name base-case-lemma-name state)))

;makes the limited version of the function and proves that calling it before the regular function is the same as just calling the regular function
;;returns (mv split-lemma-helper-name unroller-lemma-name state)
(defun completely-unroll-tail-function-helper (fn
                                               limited-fn ;the name of the function that does the first few iterations
                                               formals reps-formal exit-test-expr
                                               ;;base-case-expr
                                               update-expr-list ;the expressions passed as arguments to the recursive call
                                               state)
  (declare (xargs :mode :program ; because this calls submit-events-brief
                  :stobjs state))
  (let* ((arity (len formals)) ;pass in?
         (unroller-lemma-name (packnew limited-fn '-unroller))
         (split-lemma-helper-name ;(packnew unroller-lemma-name '-helper) ;why is unroller part of this name?
          (packnew fn '-split-lemma-helper)
          )
         (limited-fn-body `(if (boolor ,exit-test-expr ;had or here, but that led to problems in the unroller rule
                                       (zp ,reps-formal))
                               ;;no base-case computation (just returns all the formals):
                               (list ,@formals)
                             (,limited-fn ,@update-expr-list (+ -1 ,reps-formal))))
         (state (submit-events-brief `((skip-proofs
                                  (defun ,limited-fn (,@formals ,reps-formal)
                                    (declare (xargs :normalize nil)) ;may be crucial?
                                    ,limited-fn-body))

;make separate rules for the unrolling and base cases?!
                                 (defthm ,unroller-lemma-name
                                   (implies (and (syntaxp (quotep ,reps-formal))
                                                 (<= 0 ,reps-formal) ;Sun Feb 20 18:10:26 2011 ;could make a separate rule for the base case, i guess...
;                                            (< reps 100) ;fixme what if there is a case where reps is huge?!
                                                 )
                                            (equal (,limited-fn ,@formals ,reps-formal)
                                                   ,limited-fn-body))
                                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                              '(,limited-fn)))))

;this will be converted to use the alias function
                                 (defthm ,split-lemma-helper-name
                                   (equal (,fn ,@formals)
                                          (let ((limited-result (,limited-fn ,@formals ,reps-formal)))
                                            (,fn ,@(make-nth-terms arity 'limited-result))))
                                   :rule-classes nil
                                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                              '(,fn ,limited-fn nth-of-cons zp boolor))))))
                               state)))
    (mv split-lemma-helper-name unroller-lemma-name state)))

;;(split-tail-function-helper 'sha1-loop-10 '(params) '(sha1-loop-10-exit-test params) ;'params
;;                           '((sha1-loop-10-update params)) state)

;we have to use the alias so that rewrite rule introduced here doesn't loop
;ffixme will be more complicated if there are more params - handed?
;returns (mv new-fns runes unroller-rune state)
;this takes pains to ensure it doesn't cause loops
(defun completely-unroll-tail-function (fn ;the name of the function we're completely unrolling
                                        unrolling-bound ;a constant that indicates the maximum number of unrolling steps that should be needed
                                        state)
  (declare (xargs :mode :program :stobjs state))
  (let* ((formals (fn-formals fn (w state)))
         (arity (len formals))
         (reps-formal (fresh-symbol 'reps formals))
         (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
;         (nice-tail-recp (first is-a-nice-tail-function-result)) ;fixme check that this is t?!
         (exit-test-expr (second is-a-nice-tail-function-result))
         (base-case-expr (third is-a-nice-tail-function-result))
         (update-expr-list (fourth is-a-nice-tail-function-result))
         (limited-fn (packnew fn '-to-completely-unroll))
         (alias-fn (packnew fn '-should-not-execute)))
    ;;First make an a new function identical to fn (except for its name):  we expect this function to never execute because all the reps should be done by the limited function
    (mv-let (alias-fn alias-lemma-name alias-base-case-lemma-name state)
            (make-alias-for-tail-function fn formals exit-test-expr base-case-expr update-expr-list alias-fn
                                          t ;do work-hard when relieving hyps for the base case rule
                                          state)
            ;; Make a "limited" version of fn which takes an additional parameter, the number of iterations to perform, and which returns every parameter except that one when it exits).
            ;; Also, make a lemma saying that running fn is the same as first running the limited version and then running fn-alias to finish the job.
            (mv-let (split-lemma-helper-name unroller-lemma-name state)
                    ;;No need to pass in base-case-expr, because the limited fn will return all its params in the base case:
                    (completely-unroll-tail-function-helper fn limited-fn formals reps-formal exit-test-expr update-expr-list state)
                    (mv-let (split-lemma-name state)
                            (my-make-defthm (pack$ fn '-split-lemma)
                                         `(equal (,fn ,@formals)
                                                 ;;the let is new (may make the use of this faster - but why didn't it get memoized?)
                                                 (let ((limited-result (,limited-fn ,@formals ',unrolling-bound))) ;watch for clash?
                                                   (,alias-fn ,@(make-nth-terms arity 'limited-result))))
                                         `(("Goal"
                                            :use ((:instance ,split-lemma-helper-name (,reps-formal ',unrolling-bound))
                                                  (:instance ,alias-lemma-name
                                                             ,@(alist-to-doublets
                                                                (pairlis$ formals
                                                                            (make-nth-terms arity `(,limited-fn ,@formals ',unrolling-bound))))))
                                            :in-theory (theory 'minimal-theory)))
                                         state)
                            (mv (list alias-fn limited-fn)
                                (list `,split-lemma-name
                                      `,alias-base-case-lemma-name)
                                `,unroller-lemma-name
                                state))))))

;makes a limited version of the function that takes a number of iterations to perform and proves that calling the limited function (for any number of iterations) before the regular function is the same as just calling the regular function
;this version does not take a split-amount (the rewrite rule has the split amount as a free variable, so the rule must be instantiated manually)
;returns (mv split-rule-symbol new-fns other-runes state)
(defun split-tail-function (fn ;the name of the function we're making an alias of
                            state)
  (declare (xargs :mode :program :stobjs state))
  (let* ((formals (fn-formals fn (w state)))
         (arity (len formals))
         (reps-formal (fresh-symbol 'reps formals))
         (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
;         (nice-tail-recp (first is-a-nice-tail-function-result)) ;fixme check that this is t?!
         (exit-test-expr (second is-a-nice-tail-function-result))
         (base-case-expr (third is-a-nice-tail-function-result))
         (update-expr-list (fourth is-a-nice-tail-function-result))
         (limited-fn (packnew fn '-limited))
         (alias-fn (packnew fn '-final-reps)))
    ;;First make an a new function identical to fn (except for its name):
    (mv-let (alias-fn alias-lemma-name alias-base-case-lemma-name state)
            (make-alias-for-tail-function fn formals exit-test-expr base-case-expr update-expr-list alias-fn nil state)
            ;; Make a "limited" version of fn which takes an additional parameter, the number of iterations to perform, and which returns every parameter except that one when it exits).
            ;; Also, make a lemma saying that running fn is the same as first running the limited version and then running fn-alias to finish the job.
            (mv-let (split-lemma-helper-name base-case-lemma-name state)
                    ;;No need to pass in base-case-expr, because the limited fn will return all its params in the base case:
                    (split-tail-function-helper fn limited-fn formals reps-formal exit-test-expr update-expr-list state)
                    (let* ((split-lemma-name (packnew fn '-split-lemma))
                           (state
                            (submit-event-brief
                             ;; split-amount is a free var
                             `(defthm ,split-lemma-name
                                 (equal (,fn ,@formals)
                                        ;;fixme use a let here?
                                        (,alias-fn ,@(make-nth-terms arity `(,limited-fn ,@formals split-amount))))
                                 :hints (("Goal"
                                          :use ((:instance ,split-lemma-helper-name (,reps-formal split-amount))
                                                (:instance ,alias-lemma-name
                                                           ,@(alist-to-doublets
                                                              (pairlis$ formals
                                                                          (make-nth-terms arity `(,limited-fn ,@formals split-amount))))))
                                          :in-theory (theory 'minimal-theory))))
                             state)))
                      (mv split-lemma-name
                          (list alias-fn limited-fn)
                          (list `,alias-base-case-lemma-name
                                `,base-case-lemma-name)
                          state))))))

;; ;returns (mv new-fns runes unroller-runes state)
;; (defun split-tail-functions (fn-split-amount-pairs state)
;;   (declare (xargs :mode :program :stobjs state)) ;why program mode?
;;   (if (endp fn-split-amount-pairs)
;;       (mv nil nil nil state)
;;     (let* ((pair (first fn-split-amount-pairs))
;;            (fn (car pair))
;;            (split-amount (cdr pair)))
;;       (mv-let (car-fns car-runes car-unroller-rune state)
;;               (split-tail-function fn
;;                                    split-amount ;an expression over the formals (constants are okay too) - check that the right vars are mentioned?
;;                                    state)
;;               (mv-let (cdr-fns cdr-runes cdr-unroller-runes state)
;;                       (split-tail-functions (cdr fn-split-amount-pairs) state)
;;                       (mv (append car-fns cdr-fns)
;;                           (append car-runes cdr-runes)
;;                           (cons car-unroller-rune cdr-unroller-runes)
;;                           state))))))

(defun strip-cdars (x)
;  (declare (xargs :guard (alistp x)))
  (cond ((endp x) nil)
        (t (cons (cdar (car x))
                 (strip-cdars (cdr x))))))

;maybe not needed
(defthm car-of-strip-cdars
  (equal (car (strip-cdars x))
         (cdar (car x))))

(defmap map-mod (x n) (mod x n) :fixed (n))
(defmap map-floor (x n) (floor x n) :fixed (n))


;the order of the values in these sequences shouldn't matter (the values correspond to random test cases)
(defun try-to-explain-sequence-from-sequence (term seq value-seq)
  (if (equal seq value-seq)
      term
    (let ((len-seq (len-list value-seq))) ;could avoid consing this up?
      (if (equal seq len-seq)
          `(len ,term)
        (let ((len-mod-seq (map-mod len-seq 4))) ;ffffffixme gen the 4s somehow! avoid consing this up?
          (if (equal seq len-mod-seq)
              `(mod ,(len term) '4)
            nil))))))

;returns a term or nil (could there be a var named nil?)
(defun try-to-explain-sequence-from-alists-aux (seq ;the order shouldn't matter
                                                alists ;these have the format of test cases; each is a map from input vars to values
                                                )
  (declare (xargs :measure (len (first alists))))
  (let ((first-alist (first alists)))
    (if (endp first-alist)
        nil
      (let* ((first-alist (first alists))
             (entry (car first-alist))
             (var (car entry))
             (value-seq (strip-cdars alists))
             (match (try-to-explain-sequence-from-sequence var seq value-seq)))
        (or match
            (try-to-explain-sequence-from-alists-aux seq (cdr-list alists)))))))

;returns a term or nil
(defun try-to-explain-sequence-from-alists (seq ;the order shouldn't matter as long as it is in sync with the values in the alist
                                            alists ;these have the format of test cases; each is a map from input vars to values
                                            )
  (if (all-same seq)
      `',(first seq)
    (try-to-explain-sequence-from-alists-aux seq alists)))

;returns the (unquoted) constant bound of the term that explains seq in terms of values from ALISTS (e.g., 4 if it's (mod x 4) for some x in the alists), or nil to indicate failure
;fixme could we also pass in test-case-array-alists?
(defun find-bound-for-pattern (seq    ;the order shouldn't matter as long as it is in sync with the values in the alist
                               alists ;these have the format of test cases; each is a map from input vars to values
                               )
  (let ((match (try-to-explain-sequence-from-alists seq alists)))
    (if (not match)
        (prog2$ (cw "  Found no pattern.")
                nil)
      (if (quotep match)
          (prog2$ (cw "Found quotep pattern: ~x0~%" match)
                  (if (< 0 (unquote match))
                      (unquote match)
                    ;;don't want to unroll if there are no reps on any test case:
                    nil))
        (if (symbolp match)
            (prog2$ (cw "Found symbol pattern: ~x0. (FAILING since we don't yet derive bounds for vars)~%" match)
                    nil) ;ffixme if the rep-count is some input, what we do here depends on whether we have a (small) bound on the input - pass in the assumptions?
          (if (and (call-of 'mod match)
                   (quotep (farg2 match))) ;the bound of (mod x <constant>) is that constant (assuming it's a natp)
              (prog2$ (cw "Found bounded mod pattern! : ~x0~%" match)
                      (unquote (farg2 match)))
            (prog2$ (cw "Couldn't find a bound for pattern: ~x0 (FAILING)~%" match)
                    nil)))))))

;;returns (mv result analyzed-function-table state) where result is (list new-runes new-fns) or :failed
; to avoid loops, the unrolling is limited: we seek a bound on the iteration count and only unroll that much.  we intend that that amount be sufficient to unroll all appearances of the function
; Note that different calls to the unrolled function may execute a different amount of times.
;could guess the complete unrolling amout and then try to prove that the exit tests for some number of reps <= that will fire..
;axe could take an option that indicates we should assume the largest rep count on any test case is in fact the largest possible and so unroll that many times (but what if there are very few test cases?)
(defun try-to-completely-unroll (fn rep-counts ;one per test case
                                    test-cases ;in sync with rep-counts
                                    analyzed-function-table extra-stuff state)
  (declare (xargs :mode :program :stobjs state))
  (progn$ (cw "(Analyzing ~x0 for complete unrolling.~%" fn)
;          (cw "~x0 rep counts, ~x1 test cases" (len rep-counts) (len test-cases))
          ;;try to find a pattern of the trace lens in terms of the params
          ;;make sure the pattern is bounded (e.g., a constant, or mod by a constant)
          (let* ((extra-stuff-for-fn (g fn extra-stuff))
                 ;;fixme check that there's no test with more reps than this?:
                 (user-supplied-complete-unrolling-amount (g :complete-unrolling-amount extra-stuff-for-fn))
                 (unrolling-bound
                  (or (if user-supplied-complete-unrolling-amount
                          (prog2$ (cw "(Using user-supplied unrolling amount ~x0 for ~x1.)~%"
                                      user-supplied-complete-unrolling-amount fn)
                                  user-supplied-complete-unrolling-amount)
                        nil)
                      (find-bound-for-pattern rep-counts test-cases)
                      ;ffixme think about this:
                      (let ((max (maxelem rep-counts))) ;new for sha1 after splitting... think about this..
;fffixme this is a hack - maybe look for a rep count that doesn't increase with the input size? what if there are several inputs?)
;or can we find the actual pattern used for sha1? which loop is it?
                        (if (and (< 0 max)
                                 (<= max 2) ;fixme make the 2 an option that is passed in?
                                 )
                            max
                          nil)))))
            (if unrolling-bound
                (prog2$ (cw "(Doing complete unrolling, since all reps counts are at most ~x0 for ~x1:~%" unrolling-bound fn)
                        ;;rune will turn (fn ..) into: (fn-alias (nth 0 (fn-limited .. unrolling-bound)) (nth 1 (fn-limited .. unrolling-bound)) ..):
                        (mv-let (new-fns runes unroller-rune state)
                                (completely-unroll-tail-function fn ;the name of the function we're making an alias of
                                                                 unrolling-bound
                                                                 state)
                                (prog2$ (cw "))~%")
                                        (mv (list (cons unroller-rune runes)
                                                  new-fns)
                                            (s fn
                                               (s :action :unrolled (empty-map))
                                               analyzed-function-table) ;sometimes a fn will be set to a record, but here it's just t
                                            state))))
              (prog2$ (cw ")~%")
                      (mv :failed analyzed-function-table state))))))

;expand the function that seems to never make a recursive call one more time to expose the exit test
;;returns (mv result analyzed-function-table state) where result is (list new-runes new-fns)
;we may not need to do this if we have the rewriter call the prover for work-hard hyps..
;should we use work-hard on the base case lemma (add it!) instead?
(defun open-one-more-step (fn analyzed-function-table state)
  (declare (xargs :mode :program
                  :stobjs state))
  (progn$ (cw "(Making opener for one last step for ~x0 to expose its exit test.~%" fn)
          (let* ((formals (fn-formals fn (w state)))
;                 (reps-formal (fresh-symbol 'reps formals))
;                 (arity (len formals))
                 (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
;         (nice-tail-recp (first is-a-nice-tail-function-result)) ;check this?!
                 (exit-test-expr (second is-a-nice-tail-function-result))
                 (base-case-expr (third is-a-nice-tail-function-result))
                 (update-expr-list (fourth is-a-nice-tail-function-result))
                 (alias-fn (packnew fn '-never-executes))
                 )
            (mv-let (alias-fn alias-lemma-name alias-base-case-lemma-name state) ;use a better name for the alias function?
                    (make-alias-for-tail-function fn formals exit-test-expr base-case-expr update-expr-list alias-fn
                                                  t
                                                  state)
                    (let* ((expander-lemma-name (packnew fn '-one-last-step-expander))
                           (state (submit-event-brief `(defthm ,expander-lemma-name
                                                     (equal (,fn ,@formals)
                                                            (if ,exit-test-expr
                                                                ,base-case-expr
                                                              (,alias-fn ,@update-expr-list)))
                                                     :hints (("Goal" :induct t
                                                              :in-theory (union-theories (theory 'minimal-theory)
                                                                                         '(,fn ,alias-fn)))))
                                                 state)))
                      (prog2$ (cw ")")
                              (mv (list (list `,alias-lemma-name
                                              `,alias-base-case-lemma-name ;omit?
                                              `,expander-lemma-name)
                                        (list alias-fn))
                                  (s alias-fn
                                     (s :action :open-one-more (empty-map))
                                     analyzed-function-table) ;immediately mark the alias function as analyzed (the caller marked fn as analyzed)
                                  state)))))))

;returns nil or the value that is the length of each item in each trace (note that some traces may be empty!)
(defun len-of-vals-in-traces-if-all-same-len (traces)
  (if (endp traces)
      nil ;all traces were empty!?
    (let* ((trace (first traces)))
      (if (endp trace)
          ;;skip this trace:
          (len-of-vals-in-traces-if-all-same-len (cdr traces))
        ;;trace wasn't empty
        (let* ((value (first trace)))
          (if (not (consp value))
              nil
            (let ((len (len value)))
              (if (len-equal-list-list traces len)
                  len
                nil))))))))

(skip-proofs
 (mutual-recursion
;figures out the tuple structure indicated by traces
;fixme add more type information?
;fixme use the syntax of the update function to distinguish between tuples and arrays of fixed length?  also to get type information?
   (defun shape-of-traces (traces)
 ;    (declare (xargs :guard t))
    (if (nil-or-consp-list-list traces)
        ;;the values may be tuples:
        (let ((len-of-vals-in-traces-if-all-same-len (len-of-vals-in-traces-if-all-same-len traces)))
          (if (and len-of-vals-in-traces-if-all-same-len
;                   (< len-of-vals-in-traces-if-all-same-len 32) ;if you put this back, consider an exeption for hetergeneous lists?
                   )
              `(:tuple ,@(shape-of-traces-lst (get-nths-from-traces len-of-vals-in-traces-if-all-same-len traces)))
            'item))
      ;; not a tuple:
      'item))

  (defun shape-of-traces-lst (traces-lst)
    (if (endp traces-lst)
        nil
      (cons (shape-of-traces (first traces-lst))
            (shape-of-traces-lst (rest traces-lst)))))))

(defun make-formal-shape-alist (formals formal-traces-alist)
  (if (endp formals)
      nil
    (let* ((formal (first formals))
           (traces (lookup-eq formal formal-traces-alist))
           (shape (shape-of-traces traces)))
          (acons-fast formal shape (make-formal-shape-alist (rest formals) formal-traces-alist)))))


;; TODO: There are now better ways to answer questions like this
(defun event-type (name state)
  (declare (xargs :guard (symbolp name)
                  :stobjs state))
  (let ((props (getprops name 'current-acl2-world (w state))))
    (if (not props)
        (hard-error 'event-type "No props for: ~x0" (acons #\0 name nil))
      (if (assoc-eq 'theorem props)
          :theorem ;could be a rewrite rule, an axiom, or a defthm in rule classes nil
        (if (assoc-eq 'unnormalized-body props)
            :defun
          (hard-error 'event-type "Unrecognized thing: ~x0. Props: ~x1" (acons #\0 name (acons #\1 props nil))))))))

;keeps definition rules, equivalence lemmas of two rec fns and anything that includes "obeys" (the theorems about single functions, which include type facts)
;does not keep rules that transform one function into another (those can lead to long chains of work-hard hyps in the prover and should be used by the rewriter instead)
;fffixme this seems gross
(defun filter-rules-to-use-in-prover (axe-rules state)
  (declare (xargs :guard (axe-rule-listp axe-rules)
                  :stobjs state
                  :guard-hints (("Goal" :in-theory (enable axe-rulep axe-rule-listp)))))
  (if (endp axe-rules)
      nil
    (let* ((rule (first axe-rules))
           (rule-symbol (rule-symbol rule))
           (rule-string (symbol-name rule-symbol)))
      (if (or (and (<= 11 (length rule-string))
                   (equal "EQUIVALENCE" (subseq rule-string 0 11)))
              (search "OBEYS" rule-string)
              (search "LIMITED-BASE-CASE" rule-string) ;Mon Mar 14 12:27:51 2011
;              (eq :definition (rule-class rule))
              (eq :defun (event-type rule-symbol state))
              )
          (cons rule (filter-rules-to-use-in-prover (cdr axe-rules) state))
        (filter-rules-to-use-in-prover (cdr axe-rules) state)))))

;; (defun g-safe (a x)
;;   (declare (xargs :guard t))
;;   (let ((val (g a x)))
;;     (if val
;;         val
;;       (hard-error 'g-safe "Looking up the key ~x0 in the record ~x1 failed." (acons #\0 a (acons #\1 x nil))))))


;could skip supporting rec fns for which we have lemmas already?
;could skip supporting rec fns which are beneath a call to a bv operator? but that operator might not be tight!
(defun filter-rec-fn-nodes-to-handle (nodenums dag-array-name dag-array state)
  (declare (xargs :stobjs state
                  :verify-guards nil))
  (if (endp nodenums)
      nil
    (let* ((nodenum (car nodenums))
           (expr (aref1 dag-array-name dag-array nodenum)))
      (if (is-a-call-of-a-rec-fn-to-handle expr state)
          (cons nodenum (filter-rec-fn-nodes-to-handle (cdr nodenums) dag-array-name dag-array state))
        (filter-rec-fn-nodes-to-handle (cdr nodenums) dag-array-name dag-array state)))))

;now we should handle the case where the items in the target-traces need to be deconstructed...

(defun empty-trees-equal-to-tree  ()
  (declare (xargs :guard t))
  nil)

(defun filter-alist-pairs (alist keys)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (key (car entry)))
      (if (member-eq key keys)
          (cons entry (filter-alist-pairs (cdr alist) keys))
         (filter-alist-pairs (cdr alist) keys)))))

(defun drop-items-that-dont-have-vars-from-both-sets (items var-set1 var-set2)
  (if (endp items)
      nil
    (let* ((item (car items))
           (vars (get-vars-from-term item)))
      (if (and (intersection-eq vars var-set1)
               (intersection-eq vars var-set2))
          (cons item (drop-items-that-dont-have-vars-from-both-sets (cdr items) var-set1 var-set2))
        (prog2$ (cw "dropping ~x0: (vars: ~x1, formals1: ~x2, formals2: ~x3)~%" item vars var-set1 var-set2)
                (drop-items-that-dont-have-vars-from-both-sets (cdr items) var-set1 var-set2))))))

;; (defun orient-equality2 (term)
;;   (declare (xargs :mode :program))
;;   (if (and (call-of 'equal term)
;;            (not (symbolp (farg1 term))) ;new!! we keep this so that vars get substituted - can that loop?!
;;            (smaller-termp (farg1 term) (farg2 term)))
;;       `(equal ,(farg2 term) ,(farg1 term))
;;     term))

;; ;change each equality to have the bigger term first
;; ;ffixme what about when there is a var that's equated to something else
;; (defun orient-equalities (terms)
;;   (declare (xargs :mode :program))
;;   (if (endp terms)
;;       nil
;;     (cons (orient-equality2 (first terms))
;;           (orient-equalities (rest terms)))))

;for now this just skips a few specific functions - fixme add a check that the found function is recursive
(defun find-rec-fn (nodenum dag-array-name dag-array)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum)))
                  :measure (nfix nodenum)))
  (if (not (mbt (and (natp nodenum)
                     (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum)))))
      nil ; can't happen
    (let* ((expr (aref1 dag-array-name dag-array nodenum)))
      (if (or (not (consp expr))
              (quotep expr))
          (hard-error 'find-rec-fn "expected a function call but found ~x0 at nodenum ~x1."
                      (acons #\0 expr (acons #\1 nodenum nil)))
        (let ((fn (ffn-symb expr)))
          (if (and (member-eq fn '(nth bvchop ;$inline
                                   ))
                   (<= 2 (len (dargs expr)))
                   (quotep (darg1 expr)) ;the quotep is new Wed Apr 21 16:27:38 2010
                   (not (consp (darg2 expr))) ; check for nodenum (not a quoted constant)
                   )
              (find-rec-fn (darg2 expr)
                           dag-array-name
                           dag-array)
            (if (and (member-eq fn '(car cdr
                                     len ;new
                                     ))
                     (<= 1 (len (dargs expr)))
                     (not (consp (darg1 expr))) ; check for nodenum (not a quoted constant))
                     )
                (find-rec-fn (darg1 expr)
                             dag-array-name
                             dag-array)
              nodenum)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;a worklist algorithm:
;returns the list of all fns on nodes that 1) support nodes in NODENUMS and 2) are not tagged
(skip-proofs
 (defun non-tagged-supporters-with-rec-fns-to-handle-aux (nodenums miter-array-name miter-array tag-array-name tag-array done-array-name done-array acc state)
   (declare (xargs :stobjs state
                   :guard (and (nat-listp nodenums)
                               (if (consp nodenums)
                                   (pseudo-dag-arrayp miter-array-name miter-array (+ 1 (maxelem nodenums)))
                                 t)
                               (ARRAY1P TAG-ARRAY-NAME TAG-ARRAY)
                               (all-< nodenums (ALEN1 TAG-ARRAY-NAME TAG-ARRAY))
                               (ARRAY1P DONE-ARRAY-NAME DONE-ARRAY)
                               (all-< nodenums (ALEN1 DONE-ARRAY-NAME DONE-ARRAY))
                               (true-listp acc))
                   :verify-guards nil ; done below
                   ))
   (if (endp nodenums)
       acc
     (let* ((nodenum (first nodenums))
            (taggedp (aref1 tag-array-name tag-array nodenum)))
       (if taggedp
           ;;if the node is tagged, skip it:
           (non-tagged-supporters-with-rec-fns-to-handle-aux (rest nodenums) miter-array-name miter-array tag-array-name tag-array done-array-name done-array acc state)
         (let ((donep (aref1 done-array-name done-array nodenum)))
           (if donep
               ;;if the node has already been handled, skip it:
               (non-tagged-supporters-with-rec-fns-to-handle-aux (rest nodenums) miter-array-name miter-array tag-array-name tag-array done-array-name done-array acc state)
             (let* ((expr (aref1 miter-array-name miter-array nodenum)))
               (if (or (variablep expr)
                       (fquotep expr)) ;bind and check fn?
                   ;;skip quoted constants and variables:
                   (non-tagged-supporters-with-rec-fns-to-handle-aux (rest nodenums) miter-array-name miter-array tag-array-name tag-array done-array-name done-array acc state)
                 ;;function call (add the function to the accumulator, mark as done, and add children to the worklist):
                 (non-tagged-supporters-with-rec-fns-to-handle-aux
                  (append (keep-nodenum-dargs (dargs expr)) ;ffixme could pass in an acc to keep-nodenum-dargs
                          (rest nodenums))
                  miter-array-name miter-array tag-array-name tag-array
                  done-array-name
                  (aset1 done-array-name done-array nodenum t)
                  (if (is-a-rec-fn-to-handle (ffn-symb expr) state)
                      (add-to-set-eql nodenum acc)
                    acc)
                  state))))))))))

(verify-guards non-tagged-supporters-with-rec-fns-to-handle-aux)

;find supporters of nodenum that are not tagged and have rec fns to handle
(defun non-tagged-supporters-with-rec-fns-to-handle (nodenum miter-array-name miter-array tag-array-name tag-array state)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp miter-array-name miter-array (+ 1 nodenum))
                              (array1p tag-array-name tag-array)
                              (< nodenum (alen1 tag-array-name tag-array)))
                  :stobjs state))
  (non-tagged-supporters-with-rec-fns-to-handle-aux (list nodenum) miter-array-name miter-array tag-array-name tag-array
                                                    'done-array-name
                                                    (new-array1 'done-array-name (+ 1 nodenum))
                                                    nil
                                                    state))

;; (defun filter-rec-fns-to-handle (fns state)
;;   (declare (xargs :stobjs state
;;                   :verify-guards nil))
;;   (if (endp fns)
;;       nil
;;     (let ((fn (car fns)))
;;       (if (is-a-rec-fn-to-handle fn state)
;;           (cons fn (filter-rec-fns-to-handle (cdr fns) state))
;;         (filter-rec-fns-to-handle (cdr fns) state)))))

;; (defun get-split-infos (fns extra-stuff)
;;   (if (endp fns)
;;       nil
;;     (let* ((fn (car fns))
;;            (info (g fn extra-stuff))
;;            (split-amount (g :split info)))
;;       (if split-amount
;;           (cons (cons fn split-amount)
;;                 (get-split-infos (cdr fns) extra-stuff))
;;         (get-split-infos (cdr fns) extra-stuff)))))



;returns (mv unrolled-fn rune state) where the lemma has been proved in state
;fffixme add simplification of the unrolled function body?
;fffffixme handle name clashes
(defun unroll-function (fn unrolling-factor
                           expand-hint-terms ;are these always nil?
                           state)
  (declare (xargs :mode :program
                  :stobjs state))
  (let* ((unroll-events (unroll-events fn unrolling-factor expand-hint-terms state))
         (state (submit-events-brief unroll-events state)))
    (mv (pack$ fn '-unrolled-by- (nat-to-string unrolling-factor))
        `,(unroller-lemma-name fn unrolling-factor)
        state)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;returns (mv test-cases-for-term test-cases-for-not-term)
(defund partition-test-cases (test-cases term
                                        interpreted-function-alist  ;i kind of hope we don't need this
                                        true-acc false-acc)
  (declare (xargs :guard (and (test-casesp test-cases)
                              (interpreted-function-alistp interpreted-function-alist)
                              (pseudo-termp term)
                              (true-listp true-acc)
                              (true-listp false-acc))))
  (if (endp test-cases)
      (mv (reverse true-acc)
          (reverse false-acc))
    (let* ((test-case (first test-cases))
           (evaluated-term (sublis-var-and-eval (enquote-cdrs test-case) ;gross?
                                                  term interpreted-function-alist)))
      (if (not (myquotep evaluated-term))
          (prog2$ (er hard? 'partition-test-cases "Unable to evaluate test case: ~x0.  Got: ~x1." test-case evaluated-term)
                  (mv nil nil))
        (if (unquote evaluated-term)
            (partition-test-cases (rest test-cases) term interpreted-function-alist (cons test-case true-acc) false-acc)
          (partition-test-cases (rest test-cases) term interpreted-function-alist true-acc (cons test-case false-acc)))))))

;pass in interpreted-function-alist ?
(defun nodenum-has-both-true-and-false-test-cases (test-cases
                                                   nodenum dag-array-name dag-array interpreted-function-alist
                                                   found-truep found-falsep ;at least one of these will be false
                                                   )
  (declare (xargs :guard (and (test-casesp test-cases)
                              (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum))
                              (interpreted-function-alistp interpreted-function-alist))
                  :verify-guards nil ; todo: need properties of EVAL-DAG-WITH-AXE-EVALUATOR
                  ))
  (if (endp test-cases)
      (prog2$ (if found-truep
                  (cw "(Rejecting split candidate ~x0: no false test case.)~%" nodenum)
                (if found-falsep
                    (cw "(Rejecting split candidate ~x0: no true test case.)~%" nodenum)
                  (cw "(Rejecting split candidate ~x0: no true or false test case found!)~%" nodenum)))
              nil)
    (let* ((test-case (first test-cases))
           (result-array (eval-dag-with-axe-evaluator (list nodenum) dag-array-name dag-array test-case
                                                       'result-array-for-choosing-a-miter-splitter
                                                       (new-array1 'result-array-for-choosing-a-miter-splitter (+ 1 nodenum)) ;computed values are wrapped in cons
                                                       interpreted-function-alist
                                                       0 ;array-depth
                                                       ))
           (val (aref1 'result-array-for-choosing-a-miter-splitter result-array nodenum))
           (val (car val)) ;strip off the cons
           )
      (if val
          (if found-falsep
              t
            (nodenum-has-both-true-and-false-test-cases (rest test-cases) nodenum dag-array-name dag-array interpreted-function-alist
                                                        t found-falsep))
        (if found-truep
            t
          (nodenum-has-both-true-and-false-test-cases (rest test-cases) nodenum dag-array-name dag-array interpreted-function-alist
                                                      found-truep t))))))

(skip-proofs (verify-guards nodenum-has-both-true-and-false-test-cases))

;returns a nodenum
(defun smallest-node-with-both-true-and-false-test-cases-aux (nodenums dag-array-name dag-array test-cases interpreted-function-alist
                                                                       size-array smallest-size-so-far smallest-node-so-far)
  (if (endp nodenums)
      smallest-node-so-far
    (let* ((nodenum (first nodenums))
           (size (aref1 'size-array size-array nodenum)))
      (if (and (< size smallest-size-so-far) ;i guess ties go to the lowest nodenum
               (nodenum-has-both-true-and-false-test-cases test-cases nodenum dag-array-name dag-array interpreted-function-alist nil nil))
          ;;the node is the new best candidate:
          (smallest-node-with-both-true-and-false-test-cases-aux
           (rest nodenums) dag-array-name dag-array test-cases interpreted-function-alist
           size-array size nodenum)
        ;;skip the node:
        (smallest-node-with-both-true-and-false-test-cases-aux (rest nodenums) dag-array-name dag-array
                                                               test-cases interpreted-function-alist
                                                               size-array smallest-size-so-far smallest-node-so-far)))))

(skip-proofs (verify-guards smallest-node-with-both-true-and-false-test-cases-aux))

;returns nil or a nodenum
(defun find-a-node-with-both-true-and-false-test-cases (nodenums dag-array-name dag-array test-cases interpreted-function-alist)
  (if (endp nodenums)
      nil
    (let* ((nodenum (first nodenums)))
      (if (nodenum-has-both-true-and-false-test-cases test-cases nodenum dag-array-name dag-array interpreted-function-alist nil nil)
          nodenum
        (find-a-node-with-both-true-and-false-test-cases (rest nodenums) dag-array-name dag-array
                                                         test-cases interpreted-function-alist)))))

(skip-proofs (verify-guards find-a-node-with-both-true-and-false-test-cases))

;returns a nodenum or nil
;nodenums is not empty
(defun smallest-node-with-both-true-and-false-test-cases (nodenums dag-array-name dag-array test-cases interpreted-function-alist size-array)
  (let* ((first-node
          (find-a-node-with-both-true-and-false-test-cases nodenums dag-array-name dag-array test-cases interpreted-function-alist)))
    (if (not first-node)
        nil ;there is no such node (fixme should we in this case split on a node that doesn't have both true and false test cases??)
      (smallest-node-with-both-true-and-false-test-cases-aux (rest nodenums) dag-array-name dag-array test-cases interpreted-function-alist
                                                             size-array
                                                             (aref1 'size-array size-array first-node)
                                                             first-node))))

(skip-proofs (verify-guards smallest-node-with-both-true-and-false-test-cases))

;; Only returns nodenums.  These get excluded from the split candidates.
;; TODO: Can this blow up?
(defund get-boolands-and-conjuncts (nodenum-or-quotep dag-array-name dag-array dag-len acc)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (dargp-less-than nodenum-or-quotep dag-len)
                              ;(true-listp acc)
                              )
                  :measure (if (not (natp nodenum-or-quotep))
                               0
                             (+ 1 nodenum-or-quotep))))
  (if (or (not (mbt (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                         (dargp-less-than nodenum-or-quotep dag-len))))
          (consp nodenum-or-quotep))
      acc
    (let ((expr (aref1 dag-array-name dag-array nodenum-or-quotep)))
      (if (not (and (call-of 'booland expr)
                    (= 2 (len (dargs expr)))))
          (cons nodenum-or-quotep acc)
        ;;it is a call of booland:
        (let* ((acc (cons nodenum-or-quotep acc)) ;we include the booland node itself
               (acc (get-boolands-and-conjuncts (darg1 expr) dag-array-name dag-array dag-len acc)))
          (get-boolands-and-conjuncts (darg2 expr) dag-array-name dag-array dag-len acc))))))

(defthm nat-listp-of-get-boolands-and-conjuncts
  (implies (nat-listp acc)
           (nat-listp (get-boolands-and-conjuncts nodenum-or-quotep dag-array-name dag-array dag-len acc)))
  :hints (("Goal" :in-theory (enable get-boolands-and-conjuncts))))

(defthm all-<-of-get-boolands-and-conjuncts
  (implies (and (dargp-less-than nodenum-or-quotep bound)
                (natp bound)
                (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                (dargp-less-than nodenum-or-quotep dag-len)
                (all-< acc bound))
           (all-< (get-boolands-and-conjuncts nodenum-or-quotep dag-array-name dag-array dag-len acc) bound))
  :hints (("subgoal *1/11" :cases ((consp (NTH 0 (DARGS (AREF1 DAG-ARRAY-NAME DAG-ARRAY NODENUM-OR-QUOTEP))))))
          ("subgoal *1/6" :cases ((consp (NTH 1 (DARGS (AREF1 DAG-ARRAY-NAME DAG-ARRAY NODENUM-OR-QUOTEP))))))
          ("subgoal *1/3" :cases ((consp (NTH 1 (DARGS (AREF1 DAG-ARRAY-NAME DAG-ARRAY NODENUM-OR-QUOTEP))))))
          ("Goal" :in-theory (enable get-boolands-and-conjuncts))))

;; ;the also counts leaf nodes if they are equalities (since we should have merged the two equated things already)
;; ;fixme what is a leaf of the booland nest that is an equality also appears in some other context?
;; (skip-proofs
;;  (defun nodes-in-booland-nest (nodenum-or-quotep miter-array-name miter-array)
;;    (if (quotep nodenum-or-quotep)
;;        nil
;;      (let ((expr (aref1 miter-array-name miter-array nodenum-or-quotep)))
;;        (if (call-of 'booland expr)
;;            (cons nodenum-or-quotep
;;                  (append (nodes-in-booland-nest (farg1 expr) miter-array-name miter-array)
;;                          (nodes-in-booland-nest (farg2 expr) miter-array-name miter-array)))
;;          (if (call-of 'equal expr) ;new
;;              (list nodenum-or-quotep)
;;            nil))))))

(defun nodes-that-call (fn nodenum dag-array-name dag-array acc)
  (declare (xargs :measure (nfix (+ 1 nodenum))
                  :hints (("Goal" :in-theory (enable natp)))
                  :guard (and (integerp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum)))))
  (if (not (natp nodenum))
      acc
    (nodes-that-call fn (+ -1 nodenum) dag-array-name dag-array
                     (let ((expr (aref1 dag-array-name dag-array nodenum)))
                       (if (and (consp expr)
                                (eq fn (ffn-symb expr)))
                           (cons nodenum acc)
                         acc)))))

;nodenum is the top nodenum of the miter
;returns a list of nodenums
(defun nodes-to-not-use-prover-for (nodenum dag-array-name dag-array)
  (declare (xargs :guard (and (integerp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum)))))
  (nodes-that-call 'booland nodenum dag-array-name dag-array nil)
;;   (let* ((nodes-in-booland-nest (nodes-in-booland-nest nodenum dag-array-name dag-array)))
;;     (prog2$ (cw "(Nodenums not to use prover for: ~x0.)~%" nodes-in-booland-nest)
;;             nodes-in-booland-nest;includes the booland nodes and the leaf nodes
;;             ))
  )


;; see also find-node-to-split-candidates-work-list?
;ffixme think about how to choose the best splitter
;we should be sure not to choose a parent of another node to split on?
;we should have enough rules to prevent the check-integerps from failing: they depend on rules simplifying away things like (boolor t x)
;better not to cons this up this list?
;fffixme make sure things are sound if the node to split on is not a predicate..
;returns a list of nodenums
;ffixme this list can contain dups.  yuck?
;checks every node in the dag
;fixme if we switch to leaving irrelevant nodes in the dag, this will need to use a worklist algorithm
;fixme crashes if we have a not applied to a constant
(defund find-node-to-split-candidates (n dag-len dag-array-name dag-array acc)
  (declare (xargs :guard (and (natp n)
                              (pseudo-dag-arrayp dag-array-name dag-array dag-len))))
  (declare (xargs :measure (+ 1 (nfix (- dag-len n)))))
  (if (or (not (natp n))
          (not (natp dag-len))
          (<= dag-len n))
      acc
    (let ((acc (maybe-add-split-candidates (aref1 dag-array-name dag-array n) dag-array-name dag-array dag-len acc)))
      (find-node-to-split-candidates (+ 1 n) dag-len dag-array-name dag-array acc))))

(local
  (defthm true-listp-of-find-node-to-split-candidates
    (implies (true-listp acc)
             (true-listp (find-node-to-split-candidates n dag-len dag-array-name dag-array acc)))
    :hints (("Goal" :in-theory (enable find-node-to-split-candidates)))))

(local
  (defthm nat-listp-of-find-node-to-split-candidates
    (implies (and (nat-listp acc)
                  (natp n)
                  (pseudo-dag-arrayp dag-array-name dag-array dag-len))
             (nat-listp (find-node-to-split-candidates n dag-len dag-array-name dag-array acc)))
    :hints (("Goal" :in-theory (enable find-node-to-split-candidates)))))

;returns nil or a nodenum to split on
;fixme use this for the axe-prover too?  is it too slow?
;destroys 'size-array
(defun find-a-node-to-split-miter-on (dag-array-name dag-len dag-array test-cases interpreted-function-alist)
  (declare (xargs :guard (and ;(natp n)
                           (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                           (< 0 dag-len)
                           (test-casesp test-cases)
                           (interpreted-function-alistp interpreted-function-alist)
                           )))
  (b* ( ;fixme don't bother to compute sizes if there are no candidates (or for nodes above the largest candidate?)
         (size-array (make-size-array-for-dag-array-with-name dag-len dag-array-name dag-array 'size-array)) ;; TODO: Consider using a worklist?
         ;;fixme don't bother to cons this up (track the smallest node found so far):
         (candidates (find-node-to-split-candidates 0 dag-len dag-array-name dag-array nil)) ;fixme use the worklist version?
         (candidates (merge-sort-< candidates)) ;fixme remove dups from candidates
         (candidates (remove-duplicates-from-grouped-list candidates))
         ;;since we are requiring that split nodes have both true and false test cases, there is no point in considering top-level conjuncts (we must never have seen a test case where any of them was false)
         (top-level-conjuncts (get-boolands-and-conjuncts (+ -1 dag-len) dag-array-name dag-array dag-len nil))
         ;; likewise, if something is a negated top-level conjunct (or the negation of such, etc.) don't consider it
         ;; this removes conjuncts that are calls of not, but we never split on a call of not anyway:
         (nodes-not-to-consider-splitting-on (strip-all-nots-lst top-level-conjuncts dag-array-name dag-array dag-len))
;fixme could sort nodes-not-to-consider-splitting-on and do something faster
         (candidates (set-difference$ candidates nodes-not-to-consider-splitting-on))
         (- (cw "(Split candidates: ~x0)~%" candidates)))
    (and candidates
         ;fixme if a node doesn't have both true and false test cases, perhaps it or its negation is implied by the assumptions so far - why didn't it get simplified (maybe stp timed out)?
         ;it may have arisen during simplification - could sweep again, but watch out for loops...
         ;ffffixme this can be quite slow?
         (smallest-node-with-both-true-and-false-test-cases candidates dag-array-name dag-array
                                                            test-cases interpreted-function-alist
                                                            size-array))))

(defun test-case-satisfies-all-hypsp (hyps test-case interpreted-function-alist failing-test-count hyps-that-can-fail)
  (if (endp hyps)
      t
    (let* ((hyp (first hyps))
           (evaluated-hyp ;(sublis-var-and-eval (enquote-cdrs test-case) hyp interpreted-function-alist)
            (eval-axe-evaluator test-case hyp interpreted-function-alist
                                 0 ;array-depth
                                 )))
      ;;       (if (not (quotep evaluated-hyp))
      ;;           (progn$ (cw "Ifns:~%")
      ;;                   (print-list (strip-cars interpreted-function-alist))
      ;;                   (hard-error 'test-case-satisfies-all-hypsp "Unable to evaluate hyp ~X03 on test case: ~X13.  Got: ~X23. see just above for ifns:"
      ;;                               (acons #\0 hyp (acons #\1 test-case (acons #\2 evaluated-hyp (acons #\3 nil nil))))))
      (if evaluated-hyp ;(unquote evaluated-hyp)
          (test-case-satisfies-all-hypsp (rest hyps) test-case interpreted-function-alist failing-test-count hyps-that-can-fail)
        ;;the hyp failed:
        (if (member-equal hyp hyps-that-can-fail)
            ;;the hyp is allowed to fail (because it's the negated exit test)
            (prog2$ (and (eql 0 failing-test-count)
                         (progn$ (cw "(Hyp: ~x0 evaluated to nil on test case:~%" hyp)
                                 (cw ":elided") ;(print-tree test-case nil) ;use a better print function?
                                 (cw ")~%")))
                    nil)
          ;;the hyp cannot fail (indicates an error in axe's generation of hyps?)
          (prog2$ (hard-error 'test-case-satisfies-all-hypsp "Hyp: ~x0 evaluated to nil on test case, and only the exit test hyp can fail.~%"
                              (acons #\0 hyp nil))
                  nil))))))

(defun keep-test-cases-that-satisfy-hyps (test-cases hyps interpreted-function-alist failing-test-count acc hyps-that-can-fail)
  (if (endp test-cases)
      (prog2$ (and (< 0 failing-test-count)
                   (cw "(Dropping ~x0 test cases that do not satisfy the hyps (see above for the first one).)~%" failing-test-count))
              (reverse acc) ;drop the reverse?
              )
    (let ((test-case (first test-cases)))
      (if (test-case-satisfies-all-hypsp hyps test-case interpreted-function-alist failing-test-count hyps-that-can-fail)
          (keep-test-cases-that-satisfy-hyps (rest test-cases) hyps interpreted-function-alist failing-test-count (cons test-case acc) hyps-that-can-fail)
        ;;drop this test case:
        (prog2$ nil
                (keep-test-cases-that-satisfy-hyps (rest test-cases) hyps interpreted-function-alist (+ 1 failing-test-count) acc hyps-that-can-fail))))))

(defun top-fns-of-terms (terms)
  (declare (xargs :guard (true-listp terms)))
  (if (endp terms)
      nil
    (let ((term (first terms)))
      (if (variablep term)
          (top-fns-of-terms (rest terms))
        (if (call-of 'quote term)
            (top-fns-of-terms (rest terms))
          (cons (ffn-symb term)
                (top-fns-of-terms (rest terms))))))))

;ffixme some of the params of these functions are irrelevant:

(defun sum-of-cdr-lens (alist)
  (if (endp alist)
      0
    (+ (len (cdr (car alist)))
       (sum-of-cdr-lens (cdr alist)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; todo: see dag-is-purep
(defun dag-array-is-purep-aux (index len dag-array-name dag-array var-type-alist)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array len)
                              (natp index)
                              (<= index len)
                              (var-type-alistp var-type-alist))
                  :guard-hints (("Goal" :in-theory (enable expr-is-purep)))
                  :measure (nfix (- len index))))
  (if (or (>= index len)
          (not (mbt (and (natp index)
                         (natp len)))))
      t
    (let ((expr (aref1 dag-array-name dag-array index)))
      (if (and (expr-is-purep expr)
               (if (symbolp expr)
                   (if (assoc-eq expr var-type-alist) ; could move this into expr-is-purep
                       t
                     (prog2$ (cw "(Node ~x0 is not pure: ~x1.  No type in var-type-alist)~%" index expr)
                             nil))
                 t))
          (dag-array-is-purep-aux (+ 1 index) len dag-array-name dag-array var-type-alist)
        (prog2$ (cw "(Node ~x0 is not pure: ~x1.)~%" index expr) ; todo: elide (e.g., if some darg is a big constant)?
                nil)))))

; todo: ;use property lists?
; todo: faster to count down?
;checks all nodes, not just supporting nodes
;; todo: consider printing the impure patterns, rather than every node (see non-pure-expression-patterns-in-dag).
(defun dag-array-is-purep (dag-array-name dag-array dag-len var-type-alist)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (var-type-alistp var-type-alist))))
  (let ((result (dag-array-is-purep-aux 0 dag-len dag-array-name dag-array var-type-alist)))
    (prog2$ (if result
                (cw "(Dag is pure.)~%")
              (cw "(Dag is not pure.)~%"))
            result)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; For use in the measure
(defun num-true-nodes (n array-name array)
  (declare (xargs :measure (nfix (+ 1 n))))
  (if (not (natp n))
      0
    (if (aref1 array-name array n)
        ;; count this node:
        (+ 1 (num-true-nodes (+ -1 n) array-name array))
      (num-true-nodes (+ -1 n) array-name array))))

(local
  (defthm num-true-nodes-bound
    (implies (and (integerp n)
                  (<= -1 n))
             (<= (num-true-nodes n array-name array)
                 (+ 1 n)))
    :rule-classes ((:linear :trigger-terms ((num-true-nodes n array-name array))))
    :hints (("Goal" :expand ((num-true-nodes 0 array-name array))))))

(local
  (defthm num-true-nodes-of-aset1-irrel
    (implies (and ;val
               (array1p array-name array)
               ;; (natp n)
               (< index (alen1 array-name array))
               (natp index)
               (< n index))
             (equal (num-true-nodes n array-name (aset1 array-name array index val))
                    (num-true-nodes n array-name array)))
    :hints (("Goal" :expand ((num-true-nodes 0 array-name array)
                             (num-true-nodes 0 array-name (aset1 array-name array index val)))))))

(local
  (defthm num-true-nodes-of-aset1
    (implies (and val
                  (array1p array-name array)
                  (natp n)
                  (< n (alen1 array-name array))
                  (natp index)
                  (<= index n))
             (equal (num-true-nodes n array-name (aset1 array-name array index val))
                    (if (aref1 array-name array index)
                        ;; already true:
                        (num-true-nodes n array-name array)
                      (+ 1 (num-true-nodes n array-name array)))))
    :hints (("Goal" :expand ((num-true-nodes 0 array-name (aset1 array-name array 0 val)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; todo: optimize by using a stobj array and with-local-stobj
(defund nodes-are-purep (worklist dag-array-name dag-array dag-len done-array var-type-alist)
  (declare (xargs :guard (and (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (nat-listp worklist)
                              (all-< worklist dag-len)
                              (array1p 'done-array-temp done-array)
                              (all-< worklist (alen1 'done-array-temp done-array))
                              (var-type-alistp var-type-alist))
                  :measure (make-ord 1 (+ 1 (- (nfix (alen1 'done-array-temp done-array))
                                               (num-true-nodes (+ -1 (alen1 'done-array-temp done-array))
                                                               'done-array-temp done-array)))
                                     (len worklist))
                  :hints (("Goal" :do-not '(generalize eliminate-destructors)
                           :in-theory (e/d (not-<-of-car-when-all-< ; drop?
                                            <-OF-CAR-WHEN-ALL-<
                                            ;<-OF-+-OF-1-WHEN-INTEGERP
                                            )
                                           (natp))))))
  (if (or (endp worklist)
          ;; for termination:
          (not (mbt (and (array1p 'done-array-temp done-array)
                         (nat-listp worklist)
                         (all-< worklist (alen1 'done-array-temp done-array))))))
      t
    (let ((nodenum (first worklist)))
      (if (aref1 'done-array-temp done-array nodenum)
          (nodes-are-purep (rest worklist) dag-array-name dag-array dag-len done-array var-type-alist)
        (let ((expr (aref1 dag-array-name dag-array nodenum)))
          (if (variablep expr)
              (and (assoc-eq expr var-type-alist) ; the var must have a type in the alist (which is guaranteed to be an axe-type)
                   (nodes-are-purep (rest worklist) dag-array-name dag-array dag-len done-array var-type-alist))
            (if (fquotep expr) ;fixme check the value?!
                (nodes-are-purep (rest worklist) dag-array-name dag-array dag-len done-array var-type-alist)
              (and (pure-fn-call-exprp expr)
                   ;;we checked nodenum, and now we have to check its children (the non-quotep args):
                   (nodes-are-purep (append-nodenum-dargs (dargs expr) (rest worklist)) dag-array-name dag-array dag-len
                                    (aset1 'done-array-temp done-array nodenum t)
                                    var-type-alist)))))))))

;; Checks whether nodenum and all of its supporters are pure.
(defund node-is-purep (nodenum dag-array-name dag-array var-type-alist)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 nodenum))
                              (var-type-alistp var-type-alist))))
  (nodes-are-purep (list nodenum) dag-array-name dag-array (+ 1 nodenum) (new-array1 'done-array-temp (+ 1 nodenum)) var-type-alist))

;; Checks whether smaller-nodenum and larger-nodenum and all of their supporters are pure.
;; May be faster than doing the 2 checks separately.
(defund both-nodes-are-purep (smaller-nodenum larger-nodenum dag-array-name dag-array var-type-alist)
  (declare (xargs :guard (and (natp smaller-nodenum)
                              (natp larger-nodenum)
                              (< smaller-nodenum larger-nodenum)
                              (pseudo-dag-arrayp dag-array-name dag-array (+ 1 larger-nodenum))
                              (var-type-alistp var-type-alist))))
  (nodes-are-purep (list smaller-nodenum larger-nodenum) dag-array-name dag-array (+ 1 larger-nodenum) (new-array1 'done-array-temp (+ 1 larger-nodenum)) var-type-alist))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;returns (mv core-term fns-called) where fns-called includes all the functions called in the lambda args (which correspond to the values bound to variables in the let)
(defun strip-lambdas-and-gather-called-fns-aux (term acc)
  (if (variablep term)
      (mv term acc)
    (let ((fn (ffn-symb term)))
      (if (atom fn) ;not a lambda (includes quoted constants)
          (mv term acc)
        (let* ((args (fargs term))
               (lambda-body (third fn)))
          (strip-lambdas-and-gather-called-fns-aux lambda-body
                                                   (union-eq (get-fns-in-terms args)
                                                             acc)))))))
;returns (mv core-term fns-called) where fns-called includes all the functions called in the lambda args (which correspond to the values bound to variables in the let)
(defun strip-lambdas-and-gather-called-fns (term)
  (strip-lambdas-and-gather-called-fns-aux term nil))

;now allows lambas around the call to cons
(defun head-rec-list-builderp (fn state)
  (declare (xargs :stobjs state :verify-guards nil))
  (let* ((body (fn-body fn t (w state))))
    ;;looks for (if <exit> 'nil <possibly-lambda-wrapped (cons item (fn ..))> )
    ;;fixme allow the nil to be the else branch (would have to negate the exit test)
    (and (call-of 'if body)
         (equal *nil* (farg2 body))
         (mv-let (recursive-branch fns-called-in-let-bindings)
                 (strip-lambdas-and-gather-called-fns (farg3 body))
                 (and (not (member-eq fn fns-called-in-let-bindings))
                      (call-of 'cons recursive-branch)
                      ;;fixme allow lets to intervene around the item (maybe be natural) and the call to fn?
                      (call-of fn (farg2 recursive-branch)))))))

;the function body must satisfy head-rec-list-builderp
;returns (mv runes fns state)
;ffffixme compare to convert-list-builder-to-tail-events!
(defun convert-list-builder-to-tail (fn state)
  (declare (xargs :stobjs state :mode :program))
  (let* ((body (fn-body fn t (w state))) ;we know it has the right shape: (if <exit> 'nil <possibly-lambda-wrapped (cons item (fn ..))> )
         (formals (fn-formals fn (w state)))
         (arity (len formals)) ;fixme call i call the acl2 function arity?

         (exit-test (farg1 body))
         (recursive-branch (farg3 body))
         (args-to-cons (get-function-args-allows-lambdas 'cons 2 recursive-branch))
         (item-consed-on (first args-to-cons)) ;maybe lambda-wrapped
         (call-to-f (second args-to-cons))     ;maybe lambda-wrapped
         (args-to-f (get-function-args-allows-lambdas fn arity call-to-f)) ;maybe lambda-wrapped

         (new-fn (packnew fn '-tail))
         (acc-formal (fresh-symbol 'acc formals))
         (new-formals (append formals (list acc-formal)))
         (new-defun `(skip-proofs ;fixme reuse the measure for the old function!
                      (defun ,new-fn (,@new-formals)
                        (declare (xargs :normalize nil))
                        (if ,exit-test
                            ,acc-formal
                          (,new-fn
                           ,@args-to-f
                           (add-to-end ,item-consed-on ,acc-formal))))))
         (helper-lemma-name (packnew fn '-becomes- new-fn '-helper))
;can this ever fail (say, due to acl2 heuristics?)  if so, perhaps wrap up the key parts of the function, do the proof about the wrapped functions and then unwrap..
         (helper-lemma
          `(defthm ,helper-lemma-name
             (implies (true-listp ,acc-formal)
                      (equal (append ,acc-formal (,fn ,@formals))
                             (,new-fn ,@formals ,acc-formal)))
             :rule-classes nil
             :hints (("Goal" :in-theory (union-theories '(,fn
                                                          ,new-fn
                                                          APPEND-ASSOCIATIVE
                                                          append-of-nil-arg2
                                                          true-listp-of-append
                                                          (:d true-list-fix) ;fixme why didn't this work?
                                                          ;true-listp-of-true-list-fix
                                                          true-list-fix-when-true-listp
                                                          append-of-nil-arg1
                                                          append-of-cons-arg1
                                                          add-to-end)
                                                        (theory 'minimal-theory)) ;disable  LIST::EQUAL-APPEND-REDUCTION!-ALT LIST::EQUAL-APPEND-REDUCTION!
                      :induct (,new-fn ,@formals ,acc-formal)
                      :do-not '(generalize eliminate-destructors)))))
         (lemma-name (packnew fn '-becomes- new-fn))
         (lemma
          `(defthm ,lemma-name
             (equal (,fn ,@formals)
                    (,new-fn ,@formals nil))
             :hints (("Goal" :in-theory (union-theories '(append-of-nil-arg1)
                                                        (theory 'minimal-theory))
                      :use (:instance ,helper-lemma-name (,acc-formal nil))))
             ))
         (state (submit-events-brief (list new-defun helper-lemma lemma) state)))
    (mv (list `,lemma-name)
        (list new-fn)
        state)))

;; (defun wrap-conjuncts-in-if-nest (fn if-nest)
;; ;  (declare (xargs :guard t))
;;   (if (not (and (call-of 'if if-nest)
;;                 (equal *nil* (farg3 if-nest))))
;;       `(,fn ,if-nest)
;;     `(if (,fn ,(farg1 if-nest))
;;          ,(wrap-conjuncts-in-if-nest fn (farg2 if-nest))
;;        ,*nil*)))

;returns the name of the defsequence, or nil
(defun head-aux-fn-of-defsequence-aux (fn alist)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (alist-for-this-defsequence (cdr entry))
           (head-aux-name (lookup-eq :head-aux-name alist-for-this-defsequence)))
      (if (eq head-aux-name fn)
          (car entry) ;the name of this defsequence
        (head-aux-fn-of-defsequence-aux fn (cdr alist))))))

;returns the name of the defsequence, or nil
(defun head-aux-fn-of-defsequence (fn world)
  (let* ((alist (table-alist 'defsequence-table world)))
    (head-aux-fn-of-defsequence-aux fn alist)))


;the nodes should be function call nodes
(defun fns-at-nodes (nodenums dag-array-name dag-array)
  (if (endp nodenums)
      nil
    (let* ((nodenum (first nodenums))
           (expr (aref1 dag-array-name dag-array nodenum))
           (fn (ffn-symb expr)))
      (cons fn (fns-at-nodes (rest nodenums) dag-array-name dag-array)))))

;returns nil or (list nodenum fn split-amount)
(defun find-rec-fn-node-to-split (nodenums miter-array-name miter-array extra-stuff)
  (declare (xargs :guard (and (nat-listp nodenums)
                              (if (consp nodenums)
                                  (pseudo-dag-arrayp miter-array-name miter-array (+ 1 (maxelem nodenums)))
                                t))))
  (if (endp nodenums)
      nil
    (let* ((nodenum (first nodenums))
           (expr (aref1 miter-array-name miter-array nodenum)))
      (if (not (consp expr)) ; should not happen, as expr must be a function call!
          (find-rec-fn-node-to-split (rest nodenums) miter-array-name miter-array extra-stuff)
        (let* ((fn (ffn-symb expr))
               (info (g fn extra-stuff))
               (split-amount (g :split info)))
          (if split-amount
              (list nodenum fn split-amount)
            (find-rec-fn-node-to-split (rest nodenums) miter-array-name miter-array extra-stuff)))))))

;returns (mv erp alist dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
(defund add-alist-cdrs-to-dag (alist dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist dag-array-name dag-parent-array-name acc)
  (declare (xargs :guard (and (alistp alist)
                              (wf-dagp dag-array-name dag-array dag-len dag-parent-array-name dag-parent-array dag-constant-alist dag-variable-alist)
                              (bounded-axe-tree-listp (strip-cdrs alist) dag-len)
                              (alistp acc))))
  (if (endp alist)
      (mv (erp-nil)
          acc ;order is reversed, but that doesn't matter
          dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
    (let* ((entry (car alist))
           (var (car entry))
           (term (cdr entry)))
      (mv-let (erp nodenum-or-quotep dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
        (merge-tree-into-dag-array term nil dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist dag-array-name dag-parent-array-name
                                   nil ;fixme
                                   )
        (if erp
            (mv erp nil dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
          (add-alist-cdrs-to-dag (rest alist) dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist dag-array-name dag-parent-array-name
                                 (acons var nodenum-or-quotep acc)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defund fixup-dargs-special (dargs max-unrenamed-nodenum renaming-array)
  (declare (xargs :guard (and (array1p 'renaming-array renaming-array)
                              (renaming-arrayp 'renaming-array renaming-array (alen1 'renaming-array renaming-array))
                              (bounded-darg-listp dargs (alen1 'renaming-array renaming-array))
                              (natp max-unrenamed-nodenum))
                  :guard-hints (("Goal" :expand (bounded-darg-listp dargs (alen1 'renaming-array renaming-array))
                                 :in-theory (enable bounded-darg-listp)))))
  (if (endp dargs)
      nil
    (let* ((darg (first dargs))
           (fixed-up-darg (if (or (consp darg) ; tests for quotep
                                  (<= darg max-unrenamed-nodenum) ;it's a nodenum that didn't get renamed
                                  )
                              darg
                            (aref1 'renaming-array renaming-array darg))))
      (cons fixed-up-darg (fixup-dargs-special (rest dargs) max-unrenamed-nodenum renaming-array)))))

(defthm bounded-darg-listp-of-fixup-dargs-special
  (implies (and (bounded-renaming-arrayp 'renaming-array renaming-array (alen1 'renaming-array renaming-array) bound)
                (bounded-darg-listp dargs (alen1 'renaming-array renaming-array))
                (bounded-darg-listp dargs bound))
           (bounded-darg-listp (fixup-dargs-special dargs max-unrenamed-nodenum renaming-array)
                               bound))
  :hints (("Goal" :in-theory (enable fixup-dargs-special bounded-darg-listp))))

;returns (mv erp dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist renaming-array)
(defun rebuild-node-range (nodenum
                           max-nodenum
                           max-unrenamed-nodenum
                           renaming-array
                           dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                           dag-array-name dag-parent-array-name)
  (declare (xargs :guard (and (natp nodenum)
                              (natp max-nodenum)
                              (natp max-unrenamed-nodenum)
                              (wf-dagp dag-array-name dag-array dag-len dag-parent-array-name dag-parent-array dag-constant-alist dag-variable-alist)
                              (array1p 'renaming-array renaming-array)
                              (bounded-renaming-arrayp 'renaming-array renaming-array (alen1 'renaming-array renaming-array) dag-len) ; dag-len grows as we go
                              ;(< nodenum (alen1 'renaming-array renaming-array))
                              (< max-nodenum (alen1 'renaming-array renaming-array))
                              ;(< nodenum dag-len)
                              (< max-nodenum dag-len))
                  :measure (nfix (+ 1 max-nodenum (- nodenum)))))
  (if (or (not (natp nodenum))
          (not (natp max-nodenum))
          (< max-nodenum nodenum))
      (mv (erp-nil) dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist renaming-array)
    (let* ((expr (aref1 dag-array-name dag-array nodenum)))
      (if (symbolp expr) ; nothing to do for a variable
          (rebuild-node-range (+ 1 nodenum)
                              max-nodenum
                              max-unrenamed-nodenum
                              (aset1 'renaming-array renaming-array nodenum nodenum) ; or skip this?
                              dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                              dag-array-name dag-parent-array-name)
        (if (eq 'quote (ffn-symb expr)) ; nothing much to do for a constant
            (rebuild-node-range (+ 1 nodenum)
                                max-nodenum
                                max-unrenamed-nodenum
                                (aset1 'renaming-array renaming-array nodenum expr)
                                dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                                dag-array-name dag-parent-array-name)
          ;; function call:
          (let* ((fn (ffn-symb expr))
                 (dargs (dargs expr))
                 (new-dargs (fixup-dargs-special dargs max-unrenamed-nodenum renaming-array)))
            (mv-let (erp new-nodenum dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
              (add-function-call-expr-to-dag-array-with-name fn new-dargs dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist dag-array-name dag-parent-array-name)
              (if erp
                  (mv erp dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist renaming-array)
                (rebuild-node-range (+ 1 nodenum)
                                    max-nodenum
                                    max-unrenamed-nodenum
                                    (aset1 'renaming-array renaming-array nodenum new-nodenum)
                                    dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                                    dag-array-name dag-parent-array-name)))))))))

(defun bind-old-vars (old-var-to-formal-alist ;maps old vars to their formals (for a connection, will be renamed with f and g??)
                      formal-val-alist ;includes formals and values (for a connection will handle both function 1 and function 2)
                      acc
                      )
  (declare (xargs :guard (and (alistp old-var-to-formal-alist) (symbol-alistp formal-val-alist))))
  (if (endp old-var-to-formal-alist)
      acc
    (let* ((entry (car old-var-to-formal-alist))
           (old-var (car entry))
           (formal (cdr entry))
           (val (lookup-eq formal formal-val-alist)))
      (bind-old-vars (cdr old-var-to-formal-alist) formal-val-alist
                     (acons-fast old-var
                                 val
                                 acc)))))

;fixme improve this to not do consing?
(defun check-connection-on-tuples (connection args-tuple1 args-tuple2 formals1 formals2 interpreted-function-alist bindings-for-old-vars)
  (eval-axe-evaluator (extend-alist formals1 args-tuple1
                                     (extend-alist formals2 args-tuple2 bindings-for-old-vars))
                       connection
                       interpreted-function-alist
                       0 ;array depth
                       ))

(skip-proofs (verify-guards check-connection-on-tuples))

;walks down the trace
;each element of args-trace1 is a tuple of values corresponding to formals1
;each element of args-trace2 is a tuple of values corresponding to formals2
(defun check-connection-on-trace (connection args-trace1 args-trace2 formals1 formals2 interpreted-function-alist bindings-for-old-vars)
  (if (endp args-trace1)
      t
    (let ((args-tuple1 (first args-trace1))
          (args-tuple2 (first args-trace2)))
      (and (check-connection-on-tuples connection args-tuple1 args-tuple2 formals1 formals2 interpreted-function-alist bindings-for-old-vars)
           (check-connection-on-trace connection (rest args-trace1) (rest args-trace2) formals1 formals2 interpreted-function-alist bindings-for-old-vars)))))

(skip-proofs (verify-guards check-connection-on-trace))

;fixme only bother to bind the vars (and old vars) that actually appear in the connection?
(defun connection-works-on-tracesp (connection args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist trace-num)
  (if (endp  args-traces1)
      t
    (if (let* ((trace1 (first args-traces1))
               (trace2 (first args-traces2))
               (first-tuple1 (first trace1))
               (first-tuple2 (first trace2))
               )
          (check-connection-on-trace connection trace1 trace2 formals1 formals2 interpreted-function-alist
                                     (bind-old-vars old-var-to-formal-alist (pairlis$ (append formals1 formals2)
                                                                              (append first-tuple1 first-tuple2))
                                                    nil)))
        (connection-works-on-tracesp connection (rest args-traces1) (rest args-traces2) formals1 formals2 interpreted-function-alist old-var-to-formal-alist (+ 1 trace-num))
      (progn$ (cw "!!! discarding bad connection (FAILs to hold on trace ~x0):~%~x1" trace-num connection)
              (cw "args-trace1:~%")
              (print-list (first args-traces1))
              (cw "args-trace2:~%")
              (print-list (first args-traces2))
              nil))))

(skip-proofs (verify-guards connection-works-on-tracesp))

(defun discard-false-connections (connections args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist acc)
  (if (endp connections)
      acc ;reverse this?
    (let ((connection (first connections)))
      (discard-false-connections (rest connections) args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist
                                 (if (connection-works-on-tracesp connection args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist 0)
                                     (cons connection acc)
                                   ;;perhaps this should be a hard error
                                   (progn$ (cw "!!! discarding bad connection (FAILs to hold on all traces):~%~x0" connection)
                                           (cw "args-traces1:~%")
                                           (print-list args-traces1)
                                           (cw "args-traces2:~%")
                                           (print-list args-traces2)
                                           acc))))))

(skip-proofs (verify-guards discard-false-connections))

;; support for checking invariants on traces

;fixme improve this to not do consing?
(defun check-invar-on-tuple (invar args-tuple formals interpreted-function-alist bindings-for-old-vars)
  (eval-axe-evaluator (extend-alist formals args-tuple bindings-for-old-vars)
                       invar
                       interpreted-function-alist
                       0 ;array depth
                       ))

(skip-proofs (verify-guards check-invar-on-tuple))

;walks down the trace
;each element of args-trace is a tuple of values corresponding to formals
(defun check-invar-on-trace (invar args-trace formals interpreted-function-alist bindings-for-old-vars)
  (if (endp args-trace)
      t
    (let ((args-tuple (first args-trace)))
      (and (check-invar-on-tuple invar args-tuple formals interpreted-function-alist bindings-for-old-vars)
           (check-invar-on-trace invar (rest args-trace) formals interpreted-function-alist bindings-for-old-vars)))))

(skip-proofs (verify-guards check-invar-on-trace))

;fixme only bother to bind the vars (and old vars) that actually appear in the invar
(defun invar-works-on-tracesp (invar args-traces formals interpreted-function-alist old-var-to-formal-alist trace-num)
  (if (endp args-traces)
      t
    (let* ((trace (first args-traces))
           (first-tuple (first trace)))
      (if (check-invar-on-trace invar trace formals interpreted-function-alist
                                (bind-old-vars old-var-to-formal-alist (pairlis$ formals first-tuple) nil))
          (invar-works-on-tracesp invar (rest args-traces) formals interpreted-function-alist old-var-to-formal-alist (+ 1 trace-num))
        (progn$ (cw "!!! Invariant FAILs to hold on trace ~x0:~%~x1" trace-num invar)
                (cw "args-trace1:~%")
                (print-list trace)
                nil)))))

(skip-proofs (verify-guards invar-works-on-tracesp))

;invars can mention formals and old vars
(defun invars-work-on-tracesp (invars args-traces formals interpreted-function-alist old-var-to-formal-alist)
  (if (endp invars)
      t
    (and (invar-works-on-tracesp (first invars) args-traces formals interpreted-function-alist old-var-to-formal-alist 0)
         (invars-work-on-tracesp (rest invars) args-traces formals interpreted-function-alist old-var-to-formal-alist))))

(skip-proofs (verify-guards invars-work-on-tracesp))

;; support for checking the strengthened invars:

;fixme only bother to bind the vars (and old vars) that actually appear in the rv-claim
(defun rv-claim-works-on-tracesp (rv-claim args-traces formals interpreted-function-alist old-var-to-formal-alist trace-num)
  (if (endp args-traces)
      t
    (let* ((trace (first args-traces))
           (first-tuple (first trace))
           (last-tuple (last-elem trace))
           (formal-val-alist (pairlis$-fast formals last-tuple)) ;binds each formal to its value at the end of the trace
           (formal-old-val-alist (pairlis$-fast formals first-tuple)) ;bind formals to their old vals
           (alist (bind-old-vars old-var-to-formal-alist formal-old-val-alist
                                 formal-val-alist ;gets extended
                                 )))
      (if (eval-axe-evaluator alist
                               rv-claim
                               interpreted-function-alist
                               0 ;array depth
                               )
          (rv-claim-works-on-tracesp rv-claim (rest args-traces) formals interpreted-function-alist old-var-to-formal-alist (+ 1 trace-num))
        (progn$ (cw "!!! RV claim ~x0 FAILs to hold on trace #~x1:" rv-claim trace-num)
                (cw "formals ~x0~%" formals)
                (cw "First tuple in trace:~%")
                (print-list first-tuple)
                (cw "Last tuple in trace:~%")
                (print-list last-tuple)
                nil)))))

(skip-proofs (verify-guards rv-claim-works-on-tracesp))

;rv-claims can mention formals and old vars
(defun rv-claims-work-on-tracesp (rv-claims args-traces formals interpreted-function-alist old-var-to-formal-alist)
  (if (endp rv-claims)
      t
    (and (rv-claim-works-on-tracesp (first rv-claims) args-traces formals interpreted-function-alist old-var-to-formal-alist 0)
         (rv-claims-work-on-tracesp (rest rv-claims) args-traces formals interpreted-function-alist old-var-to-formal-alist))))

(skip-proofs (verify-guards rv-claims-work-on-tracesp))

;;
;; The uncdring transformation (see example in uncdr.lisp)
;;

;fixme add a detector to determine when to apply it..

(defun make-uncdr-param-replacement-alist (params numcdrs-formal)
  (if (endp params)
      nil
    (let* ((param (first params)))
      (acons param
             `(nthcdr ,numcdrs-formal ,param)
             (make-uncdr-param-replacement-alist(rest params) numcdrs-formal)))))

(defun make-uncdred-update-exprs (params update-expr-list cdred-params param-replacement-alist)
  (if (endp params)
      nil
    (let* ((param (first params)))
      (cons (if (member-eq param cdred-params)
                param ;now we don't cdr it
              (let* ((update-expr (first update-expr-list))
                     )
                (sublis-var-simple param-replacement-alist update-expr)))
            (make-uncdred-update-exprs (rest params) (rest update-expr-list) cdred-params param-replacement-alist)))))

(defun formal-renaming-alist (formals cdred-formals)
  (if (endp formals)
      nil
    (let ((formal (first formals)))
      (if (member-eq formal cdred-formals)
          (acons formal (pack$ 'new- formal) (formal-renaming-alist (rest formals) cdred-formals))
         (formal-renaming-alist (rest formals) cdred-formals)))))

;base this on formal-renaming-alist?
(defun bind-new-to-old-for-cdred-formals (formals cdred-formals)
  (if (endp formals)
      nil
    (let ((formal (first formals)))
      (if (member-eq formal cdred-formals)
          (cons (list (pack$ 'new- formal)
                      formal)
                (bind-new-to-old-for-cdred-formals (rest formals) cdred-formals))
        (bind-new-to-old-for-cdred-formals (rest formals) cdred-formals)))))

;fn is a nice tail rec fn:
;fixme relax the "nice" requirement?
;returns (mv new-runes new-fns state)
(defun remove-cdring-from-function (fn cdred-formals state)
  (declare (xargs :stobjs state :mode :program))
  (let* ((formals (fn-formals fn (w state)))

         (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
         ;; (nice-tail-functionp (first is-a-nice-tail-function-result))

         ;;move any of this stuff down?
         (exit-test-expr (second is-a-nice-tail-function-result))
         (base-case-expr (third is-a-nice-tail-function-result))
         (update-expr-list (fourth is-a-nice-tail-function-result))

         (numcdrs-formal (fresh-symbol 'numcdrs formals))
         (new-formals (cons numcdrs-formal formals))
         (new-fn (packnew fn '-uncdred))

         ;;maps the cdred formals to their corresponding nthcdr expressions
         (param-replacement-alist (make-uncdr-param-replacement-alist cdred-formals numcdrs-formal))

         (new-exit-test-expr (sublis-var-simple param-replacement-alist exit-test-expr)) ;use let?
         (new-base-case-expr (sublis-var-simple param-replacement-alist base-case-expr)) ;use let?
         (new-update-expr-list (cons `(binary-+ '1 ,numcdrs-formal)
                                     (make-uncdred-update-exprs formals update-expr-list cdred-formals param-replacement-alist)))
         (lemma-name (packnew fn '-becomes- new-fn))
         (helper-lemma-name (packnew lemma-name '-helper))
         (events `((skip-proofs
                    (defun ,new-fn ,new-formals
                      (declare (xargs :hints (("Goal" :in-theory (enable natp)))
                                      :normalize nil
                                     ;:measure (nfix (+ 1 (- (len ,(first cdred-formals)) ;fixme what if there is more than one?
                                     ;                      (nfix ,numcdrs-formal))))
                                      ))
                      (if (or (not (natp ,numcdrs-formal))
                              ,new-exit-test-expr)
                          ,new-base-case-expr
                        (,new-fn ,@new-update-expr-list))))

                    (defthm ,helper-lemma-name
                      (implies (natp ,numcdrs-formal)
                               (equal (,fn ,@(sublis-var-simple-lst
                                              (formal-renaming-alist formals cdred-formals)
                                              (sublis-var-simple-lst param-replacement-alist formals)))
                                      (,new-fn ,numcdrs-formal ,@(sublis-var-simple-lst (formal-renaming-alist formals cdred-formals) formals))))
                      :rule-classes nil
                      :hints (("Goal" :induct (,new-fn ,numcdrs-formal ,@(sublis-var-simple-lst (formal-renaming-alist formals cdred-formals) formals))
                               :do-not '(generalize eliminate-destructors)
                               :expand ((,fn ,@(sublis-var-simple-lst
                                                (formal-renaming-alist formals cdred-formals)
                                                (sublis-var-simple-lst param-replacement-alist formals))))
                               :in-theory (union-theories (theory 'minimal-theory)
                                                          '(,new-fn CONSP-OF-NTHCDR natp nfix CDR-of-NTHCDR)))))

                    (defthm ,lemma-name
                      (equal (,fn ,@formals)
                             (,new-fn '0 ,@formals))
                      :hints (("Goal"
                               :in-theory (union-theories (theory 'minimal-theory)
                                                          '(natp nthcdr-of-0 zp))
                               :use (:instance ,helper-lemma-name
                                               ,@(bind-new-to-old-for-cdred-formals formals cdred-formals)
                                               (,numcdrs-formal 0)))))))
         (state (submit-events-brief events state)))
    (mv (list `,lemma-name)
        (list new-fn)
        state)))

;fixme what if the cdring is hidden inside an update function?!
;fixme what if it's some component of a formal that gets cdred (as for a formal that's a tuple)?
(defun report-cdred-formals (formals update-expr-list)
  (if (endp formals)
      nil
      (let* ((formal (first formals))
             (update-expr (first update-expr-list)))
        (if (equal `(cdr ,formal) update-expr)
            (cons formal (report-cdred-formals (rest formals) (rest update-expr-list)))
          (report-cdred-formals (rest formals) (rest update-expr-list))))))

(defun find-cdred-formals (fn state)
    (declare (xargs :stobjs state :verify-guards nil))
  (let* ((is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
         (nice-tail-recp (first is-a-nice-tail-function-result)))
    (if (not nice-tail-recp)
        nil
      (let* ((formals (fn-formals fn (w state)))
             (update-expr-list (fourth is-a-nice-tail-function-result)))
        (report-cdred-formals formals update-expr-list)))))

(defun pure-assumptionp (term)
  (declare (xargs :guard t))
  (and (true-listp term)
       (or (and (call-of 'true-listp term)
                (variablep (farg1 term)))
           (and (call-of 'unsigned-byte-p term)
                (quotep (farg1 term)) ; todo: check for natp
                (variablep (farg2 term)))
           (and (call-of 'all-unsigned-byte-p term) ;fixme what if we have only some of the 3 things needed for an array type?
                (quotep (farg1 term))
                (variablep (farg2 term)))
;fixme what if we have only some but not all of the 3 pieces for a bv-array type?
           (and (call-of 'equal term)
                (quotep (farg1 term))
                (true-listp (farg2 term))
                (call-of 'len (farg2 term))
                (variablep (farg1 (farg2 term))))
           (and (call-of 'equal term)
                (quotep (farg2 term))
                (true-listp (farg1 term))
                (call-of 'len (farg1 term))
                (variablep (farg1 (farg1 term))))
           (and (call-of 'bv-arrayp term) ; (bv-arrayp '<element-width> '<length> val)
                (myquotep (farg1 term))
                (natp (unquote (farg1 term)))
                (myquotep (farg2 term))
                (natp (unquote (farg2 term))) ; require posp? or even require at least 2?
                )
;hopefully this will get substituted in - could in some cases drop assumptions about vars that no longer exist in the dag??
           (and (call-of 'equal term)
                (variablep (farg1 term))
                (myquotep (farg2 term))
                (or (natp (unquote (farg2 term)))
                    (all-natp (unquote (farg2 term)))))
;hopefully this will get substituted in - could in some cases drop assumptions about vars that no longer exist in the dag??
           (and (call-of 'equal term)
                (variablep (farg2 term))
                (myquotep (farg1 term))
                (or (natp (unquote (farg1 term)))
                    (all-natp (unquote (farg1 term))))))))

;use a defforall?
;fixme be more flexible - allow bv operators?!
(defun pure-assumptionsp (terms)
  (declare (xargs :guard t))
  (if (atom terms)
      t ; or check null?
    (and (pure-assumptionp (first terms))
         (pure-assumptionsp (rest terms)))))

;; ;returns the nodenums (in order) of all the rec. fn. nodes to handle
;; ;what's the best way to tell if it's a recursive function we should try to simplify?
;; ;ffixme should this check whether the function is recursive?!
;; (defun find-unhandled-rec-fn-nodes (n len dag-array-name dag-array acc state)
;;   (declare (xargs :verify-guards nil
;;                   :stobjs state
;;                   :hints (("Goal" :in-theory (disable LIST::MEMBER-EQ-IS-MEMBERP-PROPOSITIONALLY)))
;;                   :measure (+ 1 (nfix (- len n)))))
;;   (if (or (>= n len)
;;           (not (natp n))
;;           (not (natp len)))
;;       (reverse acc)
;;     (let* ((expr (aref1 dag-array-name dag-array n)))
;;       (if (not (consp expr))
;;           (find-unhandled-rec-fn-nodes (+ 1 n) len dag-array-name dag-array acc state)
;;         (let ((fn (ffn-symb expr)))
;;           ;;can fn be a lambda? no, they should not appear in dags
;;           (if (and ;(not (member-eq fn done-fns))
;;                (is-a-rec-fn-to-handle fn state))
;;               ;;               (or (member-eq fn *built-in-fns*)
;;               ;;                   (member-eq fn done-fns))
;;               ;;return the nodenum:
;;               (find-unhandled-rec-fn-nodes (+ 1 n) len dag-array-name dag-array (cons n acc) state)
;;             (find-unhandled-rec-fn-nodes (+ 1 n) len dag-array-name dag-array acc state)))))))

;returns a list of nodenums, in increasing order
;what's the best way to tell if it's a recursive function we should try to simplify?
;; todo: what about the "unhandled" part?
(defun find-unhandled-rec-fn-nodes-simple (dag acc state)
  (declare (xargs :guard (weak-dagp-aux dag)
                  :stobjs state))
  (if (endp dag)
      acc
    (let* ((entry (car dag))
           (expr (cdr entry)))
      (find-unhandled-rec-fn-nodes-simple (cdr dag)
                                          (if (not (consp expr))
                                              ;;it's a variable:
                                              acc
                                            (let ((fn (ffn-symb expr)))
                                              ;;can fn be a lambda? no, they should not appear in dags
                                              (if ;(and ;(not (member-eq fn done-fns))
                                                  (is-a-rec-fn-to-handle fn state)
                                                  ;;               (or (member-eq fn *built-in-fns*)
                                                  ;;                   (member-eq fn done-fns))
                                                  (cons (car entry) acc)
                                                acc)))
                                          state))))

(defund some-node-is-a-rec-fn-to-handlep (n dag-array-name dag-array dag-len state)
  (declare (xargs :guard (and (integerp n)
                              (<= -1 n)
                              (pseudo-dag-arrayp dag-array-name dag-array dag-len)
                              (< n dag-len))
                  :measure (nfix (+ 1 n))
                  :stobjs state))
  (if (or (not (mbt (integerp n)))
          (< n 0))
      nil
    (let* ((expr (aref1 dag-array-name dag-array n))
           (is-a-rec-fn-to-handlep (if (not (consp expr))
                                       ;;it's a variable:
                                       nil
                                     (let ((fn (ffn-symb expr)))
                                       (if (eq 'quote fn)
                                           nil
                                         (is-a-rec-fn-to-handle fn state))))))
      (if is-a-rec-fn-to-handlep
          t
        (some-node-is-a-rec-fn-to-handlep (+ -1 n) dag-array-name dag-array dag-len state)))))

;make the test cases but don't find probably-xxx nodes
;the alist pairs array names with test-case-arrays
;this is for pre-simplifying, esp. so we can know which test cases make a rec. fn. :unused (and thus might cause it to loop)
(defun make-test-case-alist (test-cases ;each test case gives values to the input vars
                             miter-array-name miter-array miter-len
                             interpreted-function-alist print
                             base-name
                             test-case-count
                             test-case-alist-acc
                             debug-nodes)
  (declare (xargs :guard (and (test-casesp test-cases)
                              (pseudo-dag-arrayp miter-array-name miter-array miter-len)
                              (< 0 miter-len)
                              (interpreted-function-alistp interpreted-function-alist)
                              (alistp test-case-alist-acc)
                              (natp test-case-count)
                              (nat-listp debug-nodes)
                              (all-< debug-nodes miter-len))))
  (if (endp test-cases)
      (reverse test-case-alist-acc)
    (b* ((test-case (first test-cases))
         (test-case-array-name (pack$ base-name '- test-case-count))
         (- (and print (member-eq print '(t :verbose :verbose!)) (cw "~%Evaluating test case ~x0.~%" test-case-count)))
         (test-case-array ; fixme: handle the case where a test failed and this is nil (except current a hard error will have already been thrown):
          (evaluate-and-check-test-case test-case
                                        miter-array-name
                                        miter-array
                                        miter-len
                                        interpreted-function-alist
                                        test-case-array-name
                                        debug-nodes)))
      (make-test-case-alist (rest test-cases)
                            miter-array-name miter-array miter-len
                            interpreted-function-alist print
                            base-name
                            (+ 1 test-case-count)
                            (acons test-case-array-name test-case-array test-case-alist-acc)
                            debug-nodes))))

;was for debugging
;; (skip -proofs
;;  (defun find-nodenum-with-bad-parents (n parent-array-name parent-array)
;;    (if (not (natp n))
;;        nil
;;      (if (not (true-listp (aref1 parent-array-name parent-array n)))
;;          n
;;        (find-nodenum-with-bad-parents (+ -1 n) parent-array-name parent-array)))))

;nodenums and fns-at-nodenums are in sync
;;returns (mv result analyzed-function-table nodenums-not-to-unroll-acc state) where result is :failed or (list new-runes new-fns)
;; :failed means that none of the fns were unrolled
(defun try-to-completely-unroll-rec-fns (nodenums fns-at-nodenums miter-array-name miter-array interpreted-function-alist extra-stuff test-cases
                                                  test-case-array-alist analyzed-function-table new-runes-acc new-fns-acc nodenums-not-to-unroll-acc state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp nodenums)
      (mv (if (endp new-fns-acc) ;nothing was unrolled:
              :failed
            (list new-runes-acc new-fns-acc))
          analyzed-function-table nodenums-not-to-unroll-acc state)
    (let ((nodenum (first nodenums)))
      (if (member nodenum nodenums-not-to-unroll-acc)
          (prog2$
           (cw "(We have already failed to completely unroll the function at node ~x0.)~%" nodenum)
           (try-to-completely-unroll-rec-fns (rest nodenums)
                                             (rest fns-at-nodenums)
                                             miter-array-name miter-array interpreted-function-alist extra-stuff
                                             test-cases test-case-array-alist analyzed-function-table
                                             new-runes-acc new-fns-acc nodenums-not-to-unroll-acc state))
        (mv-let
         (traces test-cases-for-node count) ;includes only test-cases for which the node is used, so TRACES and TEST-CASES should be in sync
         (get-traces-for-node nodenum miter-array-name miter-array interpreted-function-alist test-cases test-case-array-alist)
         (declare (ignore count))
         (if (not traces)
             ;;keeping going here is new:
             (try-to-completely-unroll-rec-fns (rest nodenums)
                                               (rest fns-at-nodenums)
                                               miter-array-name miter-array interpreted-function-alist extra-stuff
                                               test-cases test-case-array-alist analyzed-function-table
                                               new-runes-acc new-fns-acc nodenums-not-to-unroll-acc state)
           ;; (prog2$ (cw "No traces so cannot completely unroll.") ;fixme could work hard on showing the context is inconsistent?
           ;;         (mv :failed analyzed-function-table state))
           (let* ((traces (flatten-traces traces)) ;fixme save this step?
                  ;; (trace-count (len traces))
                  (rep-counts (len-list traces))
                  (real-rep-counts (sub1-list rep-counts)) ;removes 1 for the base case call from each total ;combine with the len-list?
                  (fn (first fns-at-nodenums)))
             (mv-let (result analyzed-function-table state)
                     (try-to-completely-unroll fn real-rep-counts ;one per test case
                                               test-cases-for-node ;in sync with rep-counts
                                               analyzed-function-table extra-stuff state)
                     (try-to-completely-unroll-rec-fns (rest nodenums)
                                                       (rest fns-at-nodenums)
                                                       miter-array-name miter-array interpreted-function-alist extra-stuff
                                                       test-cases test-case-array-alist analyzed-function-table
                                                       ;;move the appends inside the ifs?
                                                       (append (if (eq :failed result) nil (first result)) new-runes-acc)
                                                       (append (if (eq :failed result) nil (second result)) new-fns-acc)
                                                       (if (eq :failed result) (cons nodenum nodenums-not-to-unroll-acc) nodenums-not-to-unroll-acc)
                                                       state)))))))))

;; (defun hyp-holds-on-tracep (hyp trace formals interpreted-function-alist)
;;   (if (endp trace)
;;       t
;;     (and (eval-axe-evaluator (pairlis$-fast formals (first trace)) ;fixme save this consing?
;;                               hyp interpreted-function-alist
;;                               0 ;array-depth
;;                               )
;;          (hyp-holds-on-tracep hyp (rest trace) formals interpreted-function-alist))))

;; (skip -proofs (verify-guards hyp-holds-on-tracep))

;; (defun hyp-holds-on-tracesp (hyp traces formals interpreted-function-alist)
;;   (if (endp traces)
;;       t
;;     (and (hyp-holds-on-tracep hyp (first traces) formals interpreted-function-alist)
;;          (hyp-holds-on-tracesp hyp (rest traces) formals interpreted-function-alist))))

;; (skip -proofs (verify-guards hyp-holds-on-tracesp))

;; ;each traces is a list of "frames" each "frame" is a list of the values corresponding to the formals in a recursive call
;; (defun hyps-hold-on-tracesp (hyps traces formals interpreted-function-alist)
;;   (if (endp hyps)
;;       t
;;     (and (hyp-holds-on-tracesp (first hyps) traces formals interpreted-function-alist)
;;          (hyps-hold-on-tracesp (rest hyps) traces formals interpreted-function-alist))))

;; (skip -proofs (verify-guards hyps-hold-on-tracesp))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun remove-equalities-with-lhses (equalities lhses-to-drop)
  (declare (xargs :guard (and (true-list-listp equalities)
                              (true-listp lhses-to-drop))))
  (if (endp equalities)
      nil
    (if (member-equal (farg1 (first equalities)) lhses-to-drop)
        (remove-equalities-with-lhses (rest equalities) lhses-to-drop)
      (cons (first equalities) (remove-equalities-with-lhses (rest equalities) lhses-to-drop)))))

(defun rename-explanation-graph (alist ;maps symbols to symbols
                                 graph)
  (if (endp graph)
      nil
    (let* ((entry (first graph))
           (node1 (car entry))
           (node2 (cdr entry)))
      (cons (cons (replace-in-term2 node1 alist)
                  (replace-in-term2 node2 alist))
            (rename-explanation-graph alist (cdr graph))))))

(defun lhses-whose-rhses-mention (target-term equalities acc)
  (if (endp equalities)
      acc
    (let ((equality (first equalities)))
      (lhses-whose-rhses-mention target-term
                                 (rest equalities)
                                 (if (subtree target-term (farg2 equality))
                                     (cons (farg1 equality) acc)
                                   acc)))))

;deconstructs the candidates, but not the targets
(skip-proofs
 (mutual-recursion

  ;;fffixme give up if the candidate vals are the same on every trace?
  ;;returns a list of possible explanations (terms) or nil (meaning no explanation)
  (defun try-to-express-last-value-of-whole-non-constant-target-with-candidate (target-term
                                                                                target-value-for-each-trace ;not all-same
                                                                                candidate-term ;a nest of nths around the old version of a formal?  what about lens?
                                                                                candidate-value-for-each-trace)
    (declare (xargs :measure (acl2-count target-term))) ;;fixme bogus
    (prog2$
     nil ;(cw "Trying to express final value of target ~x0 with candidate ~x1~%" target-term candidate-term) ;check print?
     ;; (cw "Target values: ~x0~%" target-value-for-each-trace)
     ;; (cw "Candidate values: ~x0~%" candidate-value-for-each-trace)
     ;;first try to use the whole candidate:
     (let* ((possible-pattern (find-basic-unchanged-pattern target-value-for-each-trace candidate-term candidate-value-for-each-trace)))
       (if possible-pattern
           (list possible-pattern) ;fixme would we ever want to also explore using the length or the pieces?

         ;;now consider the pieces of candidate:
         ;;fixme this could consider the individual bits of integer candidates?!
         (and (nil-or-consp-list candidate-value-for-each-trace) ;if the candidates are not lists, fail

              ;;if the candidates are lists, make the list of their lengths and look for a pattern: (fixme don't do this when dropping params?)
              ;;fixme should find-basic-unchanged-pattern do this? not sure..
              ;;ffixme check if all the lens are the same - if so, consider the pieces (the lengths probably won't help explain the target).  if not, try to use the lengths to explain the target
              (let*
                  ((len-term `(len ,candidate-term))
                   (candidate-length-for-each-trace (len-list candidate-value-for-each-trace)) ;expensive to build this?
                   ;;try to explain the target using the lengths of the candidates:
                   (possible-pattern (find-basic-unchanged-pattern target-value-for-each-trace len-term candidate-length-for-each-trace)))
                (if possible-pattern
                    (list possible-pattern) ;fixme would we ever want to also explore the components?

                  (and (all-same-eql candidate-length-for-each-trace) ;if the candidates are not all of the same length, don't consider the pieces
                       ;;no pattern from the length, so consider the pieces in turn:
                       (let* ((len (first candidate-length-for-each-trace)))
                         ;;fixme can we drop this??
                         (and (< 0 len) ;disallow all nils (might loop?)
                              (or (< len 32) ;ffixme..
                                  (not (integer-listp (first candidate-value-for-each-trace))) ;fixme look at values past the first?
                                  )
                              ;;would like to avoid the consing here:
                              (let* ((candidate-component-value-for-each-trace-lst (get-nths-from-value-for-each-trace len candidate-value-for-each-trace))
                                     (candidate-term-lst (make-nth-terms len candidate-term))
                                     (candidate-component-value-for-each-trace-alist (pairlis$ candidate-term-lst candidate-component-value-for-each-trace-lst)))
                                (try-to-express-last-value-of-whole-non-constant-target-with-any-candidate
                                 target-term
                                 target-value-for-each-trace
                                 candidate-component-value-for-each-trace-alist))))))))))))

  ;;returns a list of possible explanations (terms) or nil (meaning no explanation)
  ;; the target has the same value within each trace, but these values are not all the same (ffixme not necessarily true for one caller)
  (defun try-to-express-last-value-of-whole-non-constant-target-with-any-candidate (target-term
                                                                                    target-value-for-each-trace
                                                                                    candidate-values-for-each-trace-alist)
    (if (endp candidate-values-for-each-trace-alist)
        nil
      (let* ((entry (first candidate-values-for-each-trace-alist))
             (candidate-term (car entry))
             (candidate-values-for-each-trace (cdr entry)))
        (append (try-to-express-last-value-of-whole-non-constant-target-with-candidate target-term target-value-for-each-trace candidate-term candidate-values-for-each-trace)
                (try-to-express-last-value-of-whole-non-constant-target-with-any-candidate target-term target-value-for-each-trace (rest candidate-values-for-each-trace-alist))))))))

;deconstructs the candidates, but not the targets
;;returns a list of possible explanations (terms) or nil (meaning no explanation)
;fffixme compare to try-to-express-whole-unchanged-non-constant-target-with-candidate
(defun try-to-express-last-value-of-whole-target-with-any-candidate (target-term
                                                                     target-last-values ;one for each trace
                                                                     candidate-values-for-each-trace-alist ;pairs the old expression for each candidate with its vals (one per trace)
                                                                     )
  (if (all-same target-last-values)
      (list (enquote (first target-last-values))) ;fixme what about empty traces? may be impossible since there is always a call (even if i just exits)?
    (try-to-express-last-value-of-whole-non-constant-target-with-any-candidate target-term
                                                                               target-last-values
                                                                               candidate-values-for-each-trace-alist)))

(skip-proofs
 (mutual-recursion
;deconstructs the target
  ;;acc is a list of equalities
  (defun try-to-express-last-value-of-target-tree-with-any-candidate (target-term
                                                                      target-last-values
                                                                      candidate-values-for-each-trace-alist ;pairs each candidate with its list of vals (one per trace)
                                                                      acc)
    (declare (xargs :measure (len target-term))) ;fake
    (let ((whole-patterns (try-to-express-last-value-of-whole-target-with-any-candidate target-term target-last-values candidate-values-for-each-trace-alist)))
      (if whole-patterns
          ;;fixme might we ever want to recur on the pieces of the target?
          (append (cons-onto-all 'equal (cons-onto-all target-term (enlist-all whole-patterns)))
                  acc)
        ;;(cons `(equal ,target-term ,whole-pattern) acc)
        (if (not (nil-or-consp-list target-last-values))
            ;; i guess they can't be all nils, or we would have found nil as the explanation for the whole thing
            ;; it isn't a list:  ;fixme could try to express individual bits of the target?
            acc
          ;; the targets are lists:
          (let* ((lens (len-list target-last-values))
                 (len (first lens))
                 (length-term `(len ,target-term))
                 )
            (if (all-eql$ len (rest lens))
                ;; all the targets are the same length
                (let ( ;; Add a claim for the length:
                      (acc (cons `(equal ,length-term ',len)
                                 acc)))
                  ;; Now try to express the pieces:
                  (if (or (< len 32) ;fixme - hack?
                          (not (integer-listp (first target-last-values))))
                      ;;deconstruct the target and try to express the pieces:
                      (prog2$
                       (cw "(deconstructing ~x0.)" target-term)
                       (try-to-express-last-value-of-target-tree-list-with-any-candidate (make-nth-terms len target-term)
                                                                                         (get-nths-from-value-for-each-trace len target-last-values)
                                                                                         candidate-values-for-each-trace-alist
                                                                                         acc))
                    acc))
              ;;the targets are not all the same length:
              (let* ( ;; may be nil:
                     (length-explanations (try-to-express-last-value-of-whole-target-with-any-candidate length-term lens candidate-values-for-each-trace-alist))

                     (acc (if length-explanations
                              (append (cons-onto-all 'equal (cons-onto-all length-term (enlist-all length-explanations)))
                                      acc)
                            acc))

;fixme put this back????
;                     (prefix-pattern (find-prefixp-pattern-with-any-value target-term target-traces value-traces-alist))
                     ;;fixme should this cause anything to be added to explanation-graph to prevent loops?
;                    (acc (if prefix-pattern (cons prefix-pattern acc) acc))
                     )
                acc)))))))

  ;;returns extended-acc (a list of equalities)
  (defun try-to-express-last-value-of-target-tree-list-with-any-candidate (target-term-lst
                                                                           target-last-values-lst
                                                                           candidate-values-for-each-trace-alist ;pairs candidate with its list of vals (one per trace)
                                                                           acc)
    (declare (xargs :measure (len target-term-lst)))
    (if (endp target-term-lst)
        acc
      (let ((acc (try-to-express-last-value-of-target-tree-with-any-candidate (first target-term-lst) (first target-last-values-lst) candidate-values-for-each-trace-alist acc)))
        (try-to-express-last-value-of-target-tree-list-with-any-candidate (rest target-term-lst) (rest target-last-values-lst) candidate-values-for-each-trace-alist acc))))))

;; ;;tests whether
;; ;; term-to-use is: (not (bvlt size x y))
;; ;; and some term is: (equal (bvlt size y x) 'nil)
;; ;returns (mv new-terms defthm-names-for-new-terms state)
;; (defun strengthen-to-equality (terms
;;                                term-to-use ;will be the exit test?
;;                                fn formals prover-rule-alist pushed-back-invariant-call pushed-back-invariant-name state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (not (and (call-of 'not term-to-use)
;;                 (call-of 'bvlt (farg1 term-to-use))
;; ;                  (quotep (first (fargs bvlt1)))
;;                 ))
;;       (mv nil nil state)
;;     (let* ((bvlt-expr (first (fargs term-to-use)))
;;            (x (second (fargs bvlt-expr)))
;;            (y (third (fargs bvlt-expr)))
;;            (cross-term `(equal (bvlt ,(first (fargs bvlt-expr)) ;fixme use the "not" phrasing? allow the nil to come first?
;;                                       ,y
;;                                       ,x)
;;                                 'nil)))
;;       (if (member-equal cross-term terms)
;;           ;;we try to orient the equality the right way:
;;           ;;if we can rewrite something about a formal to something about an old var, we do that:
;;           (mv-let (lhs rhs)
;;                   (orient-equality formals x y)
;;                   (let* (;(equality-strengthening-helper-theorem-name (pack$ fn '-equality-strengthening-theorem-helper))
;;                          (equality-strengthening-theorem-name (pack$ fn '-equality-strengthening-theorem))
;;                          ;fixme maybe the orientation of the conclusion of the theorem doesn't matter much, if it's not to be a rewrite rule
;;                          (stronger-term (if (quotep lhs) ;new fixme what if they are both constants?  fixme think more about how to orient these? same issues below in the signed version
;;                                             `(equal ,rhs ,lhs)
;;                                           `(equal ,lhs ,rhs)))
;;                          ;;pull the defthm out of this function? but maybe the rules depend on what we do here?
;;                          (state (submit-events-brief `((defthm ,equality-strengthening-theorem-name ;;,equality-strengthening-helper-theorem-name
;;                                               ;;could include only the relevant conjuncts of the invariant, but we need type info:
;;                                               (implies (and ,pushed-back-invariant-call ;;,cross-term
;;                                                             ,term-to-use)
;;                                                        ,stronger-term)
;;                                               :rule-classes nil
;;                                               :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
;;                                                                                          '(,pushed-back-invariant-name))
;;                                                        :do-not '(generalize eliminate-destructors))
;;                                                       (if stable-under-simplificationp
;;                                                           '(:clause-processor
;;                                                             (axe-prover
;;                                                              clause
;;                                                              ',(s :goal-name equality-strengthening-theorem-name
;;                                                                   (axe-prover-hints
;;                                                                    nil ;think about this?
;;                                                                    prover-rule-alist ;do we want all of these?  do we want the other dag prover runes from the table?
;;                                                                    nil ;interpreted-function-alist
;;                                                                    (empty-analyzed-function-table) ;fffixme
;;                                                                    ))
;;                                                              state)
;;                                                             :do-not '(generalize eliminate-destructors))
;;                                                         nil)))
;;                                             ;; (defthm ,equality-strengthening-helper-theorem-name
;; ;;                                               (implies (and ,cross-term
;; ;;                                                             ,term-to-use)
;; ;;                                                        ,stronger-term)
;; ;;                                               :hints (("goal" :in-theory (theory 'minimal-theory)
;; ;;                                                        :do-not '(generalize eliminate-destructors))
;; ;;                                                       (if stable-under-simplificationp
;; ;;                                                           '(:clause-processor
;; ;;                                                             (axe-prover
;; ;;                                                              clause
;; ;;                                                              ',(axe-prover-hints
;; ;;                                                                 nil ;think about this?
;; ;;                                                                 prover-rule-alist ;do we want all of these?  do we want the other dag prover runes from the table?
;; ;;                                                                 nil ;interpreted-function-alist
;; ;;                                                                 nil ;test cases
;; ;;                                                                 )
;; ;;                                                              state)
;; ;;                                                             :do-not '(generalize eliminate-destructors))
;; ;;                                                         nil)))
;; ;;                                             (defthm ,equality-strengthening-theorem-name
;; ;;                                               (implies (and ,pushed-back-invariant-call
;; ;;                                                             ,term-to-use)
;; ;;                                                        ,stronger-term)
;; ;;                                               :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
;; ;;                                                                                          '(,pushed-back-invariant-name))
;; ;;                                                        :use (,equality-strengthening-helper-theorem-name)
;; ;;                                                        :do-not '(generalize eliminate-destructors))))
;;                                             )
;;                                           state)))
;;                     (mv (list stronger-term)
;;                         (list equality-strengthening-theorem-name)
;;                         state)))
;;         (mv nil nil state)))))

;; (defun strengthen-to-equality-signed-version (terms
;;                                               term-to-use ;will be the exit test?
;;                                               fn formals prover-rule-alist pushed-back-invariant-call pushed-back-invariant-name state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (not (and (call-of 'not term-to-use)
;;                 (call-of 'sbvlt (first (fargs term-to-use)))))
;;       (mv nil nil state)
;;     (let* ((sbvlt-expr (first (fargs term-to-use)))
;;            (x (second (fargs sbvlt-expr)))
;;            (y (third (fargs sbvlt-expr)))
;;            (cross-term `(equal (sbvlt ,(first (fargs sbvlt-expr)) ;fixme use the "not" phrasing?
;;                                       ,y
;;                                       ,x)
;;                                'nil)))
;;       (if (member-equal cross-term terms)
;;           ;;we try to orient the equality the right way:
;;           ;;if we can rewrite something about a formal to something about an old var, we do that:
;;           (mv-let (lhs rhs)
;;                   (orient-equality formals x y)
;;                   (let* (;(equality-strengthening-helper-theorem-name (pack$ fn '-equality-strengthening-theorem-helper))
;;                          (equality-strengthening-theorem-name (pack$ fn '-equality-strengthening-theorem))
;;                          (stronger-term (if (quotep lhs)
;;                                             `(equal ,rhs ,lhs)
;;                                           `(equal ,lhs ,rhs)))
;;                          ;;pull the defthm out of this function? but maybe the rules depend on what we do here?
;;                          (state (submit-events-brief `((defthm ,equality-strengthening-theorem-name ;;,equality-strengthening-helper-theorem-name
;;                                               ;;could include only the relevant conjuncts of the invariant, but we need type info:
;;                                               (implies (and ,pushed-back-invariant-call ;;,cross-term
;;                                                             ,term-to-use)
;;                                                        ,stronger-term)
;;                                               :rule-classes nil
;;                                               :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
;;                                                                                          '(,pushed-back-invariant-name))
;;                                                        :do-not '(generalize eliminate-destructors))
;;                                                       (if stable-under-simplificationp
;;                                                           '(:clause-processor
;;                                                             (axe-prover
;;                                                              clause
;;                                                              ',(s :goal-name equality-strengthening-theorem-name
;;                                                                   (axe-prover-hints
;;                                                                    nil ;think about this?
;;                                                                    prover-rule-alist ;do we want all of these?  do we want the other dag prover runes from the table?
;;                                                                    nil ;interpreted-function-alist
;;                                                                    nil ;test cases
;;                                                                    (empty-analyzed-function-table) ;fffixme
;;                                                                    ))
;;                                                              state)
;;                                                             :do-not '(generalize eliminate-destructors))
;;                                                         nil)))
;; ;;                                             (defthm ,equality-strengthening-theorem-name
;; ;;                                               (implies (and ,pushed-back-invariant-call
;; ;;                                                             ,term-to-use)
;; ;;                                                        ,stronger-term)
;; ;;                                               :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
;; ;;                                                                                          '(,pushed-back-invariant-name))
;; ;;                                                        :use (,equality-strengthening-helper-theorem-name)
;; ;;                                                        :do-not '(generalize eliminate-destructors))))
;;                                             )
;;                                           state)))
;;                     (mv (list stronger-term)
;;                         (list equality-strengthening-theorem-name)
;;                         state)))
;;         (mv nil nil state)))))

;returns (mv erp proved-claims defthm-names state)
;proves that pushed-back-invariant-call implies each of the user-supplied-rv-claims
;can some of these fail?
;for each user-supplied-rv-claim, prove that the invariant and exit test imply it..
(defun prove-final-claims-aux (claims
                               hyps ;will be the exit test and invar?
                               base-name count max-conflicts rule-alist interpreted-function-alist proved-claims-acc defthm-names-acc state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp claims)
      (mv (erp-nil) proved-claims-acc defthm-names-acc state)
    (let* ((claim (first claims))
           (defthm-name (packnew base-name count)))
      (mv-let (erp provedp state)
              (prove-theorem-with-axe-prover claim
                                             hyps
; (list invariant-call ;;could include only the relevant conjuncts of the invariant, but we need type info:
;      term-to-use)
                                             defthm-name max-conflicts
                                             (list rule-alist)
                                             nil ;monitored-symbols
                                             interpreted-function-alist :brief
                                             nil ;options
                                             state)
              (if erp
                  (mv erp nil nil state)
                (prog2$ (and (not provedp)
                             (cw "(!! Discarding RV claim ~x0.)~%" claim))
                        (prove-final-claims-aux (rest claims) hyps base-name (+ 1 count) max-conflicts rule-alist interpreted-function-alist
                                                (if provedp (cons claim proved-claims-acc) proved-claims-acc)
                                                (if provedp (cons defthm-name defthm-names-acc) defthm-names-acc)
                                                state)))))))

;returns (mv erp proved-claims defthm-names-for-proved-claims state)
;use some sort of pattern matching or rewriting for this (maybe with polarities?)?
;may need to combine two of more of the TERMS with TERM-TO-USE
;remove this wrapper?
;fixme think about analyzed-function table
(defun prove-final-claims (rv-claims
                           hyps ;the simplified, expanded exit test and invariant-call
                           base-name max-conflicts prover-rule-alist runes interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (b* ((- (cw "(Trying to prove final claims ~x0 (Assumptions:~%~x1):~%" rv-claims hyps))
       ((mv erp rule-alist)
        (add-to-rule-alist runes ;this isn't done by the parent, is it?
                           prover-rule-alist
                           (w state)))
       ((when erp) (mv erp nil nil state))
       ((mv erp proved-claims defthm-names-for-proved-claims state)
        ;;for each user-supplied rv-claim, prove the (pushed back) invar and exit test imply it:
        (prove-final-claims-aux rv-claims hyps base-name 0 max-conflicts
                                rule-alist
                                interpreted-function-alist nil nil state))
       ;; (mv-let (new-terms1 defthm-names-for-new-terms1 state)
       ;;         (strengthen-to-equality terms term-to-use fn formals prover-rule-alist invariant-call invariant-name state)
       ;;         (mv-let (new-terms2 defthm-names-for-new-terms2 state)
       ;;                 (strengthen-to-equality-signed-version terms term-to-use fn formals prover-rule-alist invariant-call invariant-name state)
       ;;                 ;;fffixme add more strengthenings here! what about rewriting the terms assuming the others and the negated exit test?  might make stuff worse?
       ;;                 ;;could do all the strengthenings and then call prove-final-claims on both the user-supplied and axe-supplied strengthenings?
       ;;                 (let ((stronger-invars (append extra-terms new-terms1 new-terms2)))
       ((when erp) (mv erp nil nil state))
       (- (cw "proved RV claims: ~x0)~%" proved-claims))
       )
    (mv (erp-nil)
        proved-claims defthm-names-for-proved-claims ;(append defthm-names-for-proved-claims defthm-names-for-new-terms1 defthm-names-for-new-terms2)
        state)))

;returns (mv runes state) where the runes have been proved in STATE
(defun make-rules-to-expose-tuple-elements-for-formals (formals ;walk down this one
                                                        args ;in sync with the formals, each is a nodenum-or-quotep
                                                        formal-num
                                                        fn
                                                        all-formals
                                                        dag-lst formal-shape-alist
                                                        runes-acc
                                                        state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp formals)
      (mv runes-acc state)
    (let* ((formal (first formals))
           (arg (first args))
           (shape (lookup-eq formal formal-shape-alist))
           )
      (if (and (call-of :tuple shape)
               (atom arg)                            ;;arg is a nodenum
               (let ((expr (lookup-eq arg dag-lst))) ;slow?
                 (and (consp expr) ;fixme what if expr is a variable? might we want to split it?
                      (let ((fn (ffn-symb expr)))
                        ;;fixme think about when we want to do it.  definitely if fn is nth or a loop fn.
                        (and (not (eq 'quote fn))
                             (not (eq 'cons fn)) ;prevents loops
                             (not (eq 'bv-array-write fn)) ;think about this.  what if not all values are exposed in the write?  do we want to "blast" it?
                             )))))
          (let* ((defthm-name (packnew fn '-expose-tuple-for-arg- formal-num))
                 (tuple-length (len (rest ;strips off the :tuple
                                     (lookup-eq formal formal-shape-alist))))
                 (defthm `(defthm ,defthm-name
                            (implies (and (axe-syntaxp (not (syntactic-call-of 'cons ,formal dag-array)))
                                          (axe-syntaxp (not (syntactic-call-of 'make-tuple ,formal dag-array)))
                                          ;;think about this:
                                          (axe-syntaxp (not (syntactic-call-of 'bv-array-write ,formal dag-array)))
                                          (equal ,tuple-length (len ,formal))
                                          (true-listp ,formal))
                                     (equal (,fn ,@all-formals)
                                            (,fn ,@(replace-in-terms2 all-formals
                                                                      (acons formal `(make-tuple 0 ,tuple-length ,formal) nil)))))
                            :hints (("Goal" :in-theory (union-theories '(MAKE-TUPLE-DROPPER) (theory 'minimal-theory))))))
                 (state (submit-event-brief defthm state)))
            (make-rules-to-expose-tuple-elements-for-formals (rest formals)
                                                             (rest args)
                                                             (+ 1 formal-num)
                                                             fn
                                                             all-formals
                                                             dag-lst formal-shape-alist
                                                             (cons `,defthm-name runes-acc)
                                                             state))
        (make-rules-to-expose-tuple-elements-for-formals (rest formals)
                                                         (rest args)
                                                         (+ 1 formal-num)
                                                         fn
                                                         all-formals
                                                         dag-lst formal-shape-alist
                                                         runes-acc
                                                         state)))))

;walks down the dag
;returns (mv runes state)
(defun make-rules-to-expose-tuple-elements (dag-lst analyzed-function-table acc state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp dag-lst)
      (mv acc state)
    (let* ((entry (car dag-lst))
           (expr (cdr entry)))
      (mv-let (runes state)
              (if (and (consp expr)
                       (g (ffn-symb expr) analyzed-function-table) ;will fail pretty fast for bv ops
                       (eq :proved-invariant (g :action (g (ffn-symb expr) analyzed-function-table))))
                  (let* ((formal-shape-alist (g-safe :formal-shape-alist (g (ffn-symb expr) analyzed-function-table)))
                         (formals (fn-formals (ffn-symb expr) (w state)))
                         (args (fargs expr));;ffixme what about formals that are trees whose parts should be exposed?!
                         )
                    (make-rules-to-expose-tuple-elements-for-formals formals args 0 (ffn-symb expr) formals dag-lst formal-shape-alist
                                                             nil state))
                (mv nil state))
              (make-rules-to-expose-tuple-elements (rest dag-lst) analyzed-function-table (append runes acc) state)))))

;returns (mv erp dag state)
(defun get-dag-for-expr-no-theorem (expr interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (let* ((is-a-simple-callp (call-of-user-fnp expr))
         (expanded-expr (if (not is-a-simple-callp)
                            (prog2$ nil ;(cw "(Nothing to expand.)~%") ;don't print this?
                                    expr)
                          (prog2$ (cw "(Expanding the expression ~x0.)~%" expr)
                                  (expand-fn-call-expr expr state)))))
    ;; step 2 handles a call to DAG-VAL-WITH-AXE-EVALUATOR, just returning the dag.  i guess it also may commute xors and do other stuff - fixme what if the ifns are wrong?
    (rewrite-term expanded-expr :runes (lookup-rules) :interpreted-function-alist interpreted-function-alist)))

;returns (mv erp dags state)
(defun get-dags-for-exprs-no-theorem (exprs interpreted-function-alist acc state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp exprs)
      (mv (erp-nil) (reverse-list acc) state)
    (mv-let (erp dag state)
      (get-dag-for-expr-no-theorem (first exprs) interpreted-function-alist state)
      (if erp
          (mv erp nil state)
        (get-dags-for-exprs-no-theorem (rest exprs) interpreted-function-alist (cons dag acc) state)))))

;turn a term into a dag, opening a call to user-defined function (like an update, exit, or base function) handles embedded dags and
;; Returns (mv erp dag state).
;ex: (get-dag-for-expr '(STREAM-BYTES-TAIL-NEW-UPDATE-0 NEW-ACC NEW-S-BOX NEW-J NEW-COUNT) .. .. state)
;fixme have this return a theorem (maybe rewriting the expr to a call of dag-val... on the resulting dag)
(defun get-dag-for-expr (expr defthm-name interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  ;;Step 1 expands the function call (if any):
  (let* ((is-a-simple-callp (call-of-user-fnp expr))
         (step-1-defthm-name (packnew defthm-name '-helper1))
         (step-2-defthm-name (packnew defthm-name '-helper2)))
    (mv-let (expanded-expr state)
      (if (not is-a-simple-callp)
          (mv expr state)
        (prog2$ (cw "(Expanding the expression ~x0.)~%" expr)
                (expand-fn-call-expr-and-prove-theorem expr step-1-defthm-name state)))
      ;; Step 2 handles a call to DAG-VAL-WITH-AXE-EVALUATOR, if any, just returning the dag.
      ;;i guess it also may eval ground terms (but we turn off xor simplification) - fixme what if the ifns are wrong?
      ;;i guess we could simplify here...
      (mv-let (erp dag state)
        (rewrite-term-and-prove-theorem expanded-expr
                                        step-2-defthm-name
                                        nil                        ;assumptions
                                        (lookup-rules) ;in case there is an embedded dag
                                        interpreted-function-alist
                                        nil             ;normalize-xors
                                        nil             ;rule-classes
                                        state)
        (if erp
            (mv erp nil state)
          (let ((state (submit-event-brief `(defthm ,defthm-name
                                        (equal ,expr
                                               ;;pull out this pattern?
                                               (dag-val-with-axe-evaluator ',dag
                                                                           ,(make-acons-nest (dag-vars-unsorted dag))
                                                                           ;;fixme think about this:
                                                                           ;;check that all the fns are already in interpreted-function-alist?
                                                                           ;;',interpreted-function-alist
                                                                           ;;is this overkill?
                                                                           ',(supporting-interpreted-function-alist
                                                                              (dag-fns dag)
                                                                              interpreted-function-alist
                                                                              t)
                                                                           '0))
                                        :rule-classes nil
                                        :hints (("Goal" :use ((:instance ,step-2-defthm-name)
                                                              ,@(and is-a-simple-callp `((:instance ,step-1-defthm-name))))
                                                 :in-theory (theory 'minimal-theory))))
                                     state)))
            (mv (erp-nil) dag state)))))))

;make a version that does not make theorems?
;returns (mv erp dags state)
(defun get-dags-for-exprs (exprs acc defthm-names interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp exprs)
      (mv (erp-nil) (reverse-list acc) state)
    (mv-let (erp dag state)
      (get-dag-for-expr (first exprs) (first defthm-names) interpreted-function-alist state)
      (if erp
          (mv erp nil state)
        (get-dags-for-exprs (rest exprs) (cons dag acc) (rest defthm-names)  interpreted-function-alist state)))))

;don't bother to check the formals?
(defun expand-update-fn-calls (terms formals state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp terms)
      nil
    (let ((term (first terms)))
      (cons (if (call-of-user-fn-on-formalsp term formals)
                (expand-fn-call-expr term state)
              term)
            (expand-update-fn-calls (rest terms) formals state)))))

;; Returns (mv erp result state) where result is nil or the name of the numcdrs formal.
(defun find-numcdrs-formal-for-tail-rec-consumer (formal-update-expr-alist ;excludes the update for lst-formal (which will just be lst-formal)
                                                  all-exprs-to-check ;excludes the update for lst-formal (uses lst-formal in a non-blessed way) but includes the exit and base exprs
                                                  lst-formal formals interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp formal-update-expr-alist)
      (mv (erp-nil) nil state)
    (let* ((entry (car formal-update-expr-alist))
           (numcdrs-formal (car entry))
           (update-expr (cdr entry))
           ;;expand the call to the update-fn, if present:
           (update-expr (if (call-of-user-fn-on-formalsp update-expr formals)
                            (expand-fn-call-expr update-expr state)
                          update-expr)))
      (mv-let
        (erp update-dag state)
        (rewrite-term update-expr :runes (lookup-rules) :interpreted-function-alist interpreted-function-alist) ;this will inline handle dag-val-with-axe-evaluator if present ;pass in ifs?
        (if erp
            (mv erp nil state)
          ;;fixme what if we need to open an update fn or deal with an embedded dag?
          (if (not (equal update-dag `((1 BINARY-+ '1 0) (0 . ,numcdrs-formal)) ; `(binary-+ '1 ,numcdrs-formal)
                          )) ;fixme what if it's a bvplus instead of binary-+?
              ;;the numcdrs formal must be incremented by one, so keep looking
              (find-numcdrs-formal-for-tail-rec-consumer (cdr formal-update-expr-alist) all-exprs-to-check lst-formal formals interpreted-function-alist state)
            ;;now check whether all mentions of lst-formal are okay.  do it by replacing the allowed mentions of lst-formal along with numcdrs-formal
            ;; and seeing if any mentions of lst-formal remain
            (let* ((replacement-equalities `((equal (endp (nthcdr ,numcdrs-formal ,lst-formal)) ':fake)
                                             (equal (car (nthcdr ,numcdrs-formal ,lst-formal)) ':fake)))
                   (all-exprs-to-check (expand-update-fn-calls all-exprs-to-check formals state)) ;could these be huge?
                   )
              (mv-let
                (erp all-dags-to-check state)
                (rewrite-terms all-exprs-to-check nil state) ;pass in ifs?
                (if erp
                    (mv erp nil state)
                  (mv-let
                    (erp replaced-dags state)
                    (rewrite-terms-with-assumptions all-exprs-to-check replacement-equalities nil state) ;;(replaced-exprs-to-check (replace-in-terms2 all-exprs-to-check replacement-alist))
                    (if erp
                        (mv erp nil state)
                      (if (and (not (member-eq lst-formal (get-vars-from-dags replaced-dags)))
;(subterm-of-anyp `(car (nthcdr ,numcdrs-formal ,lst-formal)) all-exprs-to-check) ;ensure that the car of nthcdr pattern actually appears
                               (subdag-of-somep `((3 CAR 2)
                                                  (2 NTHCDR 0 1)
                                                  (1 . ,LST-FORMAL)
                                                  (0 . ,NUMCDRS-FORMAL))
                                                all-dags-to-check))
                          (mv (erp-nil) numcdrs-formal state) ;;found the numcdrs formal!
                        ;;otherwise, keep looking:
                        (find-numcdrs-formal-for-tail-rec-consumer (cdr formal-update-expr-alist) all-exprs-to-check lst-formal formals interpreted-function-alist state)))))))))))))

;; ;returns nil or the name of the numcdrs formal
;; (defun find-numcdrs-formal-for-tail-rec-consumer (formal-update-expr-alist  ;excludes the update for lst-formal (which will just be lst-formal)
;;                                                   all-exprs-to-check ;excludes the update for lst-formal (uses lst-formal in a non-blessed way) but includes the exit and base exprs
;;                                                   lst-formal)
;;   (if (endp formal-update-expr-alist)
;;       nil
;;     (let* ((entry (car formal-update-expr-alist))
;;            (numcdrs-formal (car entry))
;;            (update-expr (cdr entry)))
;;       ;;fixme what if we need to open an update fn or deal with an embedded dag?
;;       (if (not (equal update-expr `(binary-+ '1 ,numcdrs-formal))) ;fixme what if it's a bvplus?
;;           ;the numcdrs formal must be incremented by one, so keep looking
;;           (find-numcdrs-formal-for-tail-rec-consumer (cdr formal-update-expr-alist) all-exprs-to-check lst-formal)
;;         ;;now try replacing the allowed mentions of lst-formal along with numcdrs-formal and see if any mentions of lst-formal remain
;;         (let* ((terms-to-replace `((endp (nthcdr ,numcdrs-formal ,lst-formal))
;;                                    (car (nthcdr ,numcdrs-formal ,lst-formal))))
;;                (replacement-alist (pairlis$-fast terms-to-replace (repeat (len terms-to-replace) :fake)))
;;                (replaced-exprs-to-check (replace-in-terms2 all-exprs-to-check replacement-alist)))
;;           (if (and (not (member-eq lst-formal (get-vars-from-terms replaced-exprs-to-check)))
;;                    (subterm-of-anyp `(car (nthcdr ,numcdrs-formal ,lst-formal)) all-exprs-to-check)) ;ensure that the car of nthcdr pattern actually appears
;;               numcdrs-formal ;;found the numcdrs formal!
;;             ;;otherwise, keep looking:
;;             (find-numcdrs-formal-for-tail-rec-consumer (cdr formal-update-expr-alist) all-exprs-to-check lst-formal)))))))



;ffixme what about consumers that have their args bound up into a tuple?  all this stuff will need to be extended to handle that
;returns (mv erp result states) where result is the name of the numcdrs parameter, if fn is a consumer of the list passed in via lst-formal, otherwise nil
;fixme, one should also check that the returned numcdrs parameter is initially 0
;fn should be a nice tail rec fn
;;ex: (tail-rec-consumer 'BVXOR-LIST-SPECIALIZED-TAIL-UNCDRED 'y ..interpreted-function-alist state)
(defun tail-rec-consumer (fn lst-formal interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (let* ( ;(body (fn-body fn t (w state)))
         (formals (fn-formals fn (w state)))
         (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
         ;; (nice-tail-functionp (first is-a-nice-tail-function-result)) should always be true
         (exit-test-expr (second is-a-nice-tail-function-result))
         (base-case-expr (third is-a-nice-tail-function-result))
         (update-expr-list (fourth is-a-nice-tail-function-result))
         (formal-update-expr-alist (pairlis$-fast formals update-expr-list))
         (update-expr-for-lst-formal (lookup-eq lst-formal formal-update-expr-alist)))
    (if (not (or (eq update-expr-for-lst-formal
                     lst-formal)
                 (and (call-of-user-fn-on-formalsp update-expr-for-lst-formal formals)
                      ;;fixme maybe need to handle an embedded dag?
                      (eq (expand-fn-call-expr update-expr-for-lst-formal state)
                          lst-formal))))
        ;;the lst-formal must be passed through unchanged
        (mv (erp-nil) nil state)
      ;;and there must be a numcdrs formal such that the lst-formal is only used inside:
      ;; (endp (nthcdr <numcdrs-formal> <lst-formal>)) and (car (nthcdr <numcdrs-formal> <lst-formal>))
      (let ((update-expr-alist-for-other-formals (remove-assoc-equal lst-formal formal-update-expr-alist)))
        (find-numcdrs-formal-for-tail-rec-consumer
         update-expr-alist-for-other-formals
         (cons exit-test-expr (cons base-case-expr (strip-cdrs update-expr-alist-for-other-formals)))
         lst-formal formals interpreted-function-alist state)))))

;; ;ffixme what about consumers that have their args bound up into a tuple?  all this stuff will need to be extended to handle that
;; ;returns the name of the numcdrs parameter, if fn is a consumer of the list passed in via lst-formal, otherwise nil
;; ;fixme, one should also check that the returned numcdrs parameter is initially 0
;; ;fn should be a nice tail rec fn
;; ;;ex: (tail-rec-consumer 'BVXOR-LIST-SPECIALIZED-TAIL-UNCDRED 'y state)
;; (defun tail-rec-consumer (fn lst-formal state)
;;   (declare (xargs :mode :program :stobjs state))
;;   (let* ( ;(body (fn-body fn t (w state)))
;;          (formals (fn-formals fn (w state)))
;;          (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
;;          ;; (nice-tail-functionp (first is-a-nice-tail-function-result)) should always be true
;;          (exit-test-expr (second is-a-nice-tail-function-result))
;;          (base-case-expr (third is-a-nice-tail-function-result))
;;          (update-expr-list (fourth is-a-nice-tail-function-result))
;;          (formal-update-expr-alist (pairlis$-fast formals update-expr-list))
;;          (update-expr-for-lst-formal (lookup-eq lst-formal formal-update-expr-alist)))
;;     (and ;the lst-formal must be passed through unchanged:
;;      (or (eq update-expr-for-lst-formal
;;              lst-formal)
;;          (and (call-of-user-fn-on-formalsp update-expr-for-lst-formal formals)
;;               ;;fixme maybe need to handle an embedded dag?
;;               (eq (expand-fn-call-expr update-expr-for-lst-formal state)
;;                   lst-formal)))
;;      ;;and there must be a numcdrs formal such that the lst-formal is only used inside:
;;      ;; (endp (nthcdr <numcdrs-formal> <lst-formal>)) and (car (nthcdr <numcdrs-formal> <lst-formal>))
;;      (let ((update-expr-alist-for-other-formals (remove-assoc-equal lst-formal formal-update-expr-alist)))
;;        (find-numcdrs-formal-for-tail-rec-consumer
;;         update-expr-alist-for-other-formals
;;         (cons exit-test-expr (cons base-case-expr (strip-cdrs update-expr-alist-for-other-formals)))
;;         lst-formal)))))

;; Returns (mv erp result state).
(defun consumer-numcdrs-parameters-aux (formals fn interpreted-function-alist state acc)
  (declare (xargs :mode :program :stobjs state))
  (if (endp formals)
      (mv (erp-nil) acc state)
    (mv-let (erp possible-numcdr-parameter state)
      (tail-rec-consumer fn (first formals) interpreted-function-alist state)
      (if erp
          (mv erp nil state)
        (consumer-numcdrs-parameters-aux (rest formals) fn interpreted-function-alist state
                                         (if possible-numcdr-parameter
                                             (add-to-set-eq possible-numcdr-parameter acc)
                                           acc))))))

;returns (mv erp result state)
;these are the formals not to try to drop...
(defun consumer-numcdrs-parameters (fn interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (let* ((formals (fn-formals fn (w state))))
    (consumer-numcdrs-parameters-aux formals fn interpreted-function-alist state nil)))


;fixme do this without rewriting?
;returns (mv erp dag state)
(defun replace-in-dag (dag
                       alist ;maps terms to the terms that should replace them
                       state)
  (declare (xargs :mode :program :stobjs state))
  (if (and (pseudo-term-listp (strip-cars alist))
           (pseudo-term-listp (strip-cdrs alist)))
      (rewrite-dag dag :runes (lookup-rules) :assumptions (make-equalities-from-alist alist) :normalize-xors nil)
    (prog2$ (hard-error 'replace-in-dag "bad alist: ~x0." (acons #\0 alist nil))
            (mv (erp-t) nil state))))

;returns (mv erp dags state)
(defun replace-in-dags-aux (dags alist acc state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp dags)
      (mv (erp-nil) (reverse-list acc) state)
    (mv-let (erp dag state)
      (replace-in-dag (first dags) alist state)
      (if erp
          (mv erp nil state)
        (replace-in-dags-aux (rest dags) alist (cons dag acc) state)))))

;fixme this could return theorems too?
;returns (mv erp dags state)
(defun replace-in-dags (dags alist state)
  (declare (xargs :mode :program :stobjs state))
  (replace-in-dags-aux dags alist nil state))

;todo: use this more?
;todo: if the dag is small, we can just make it into a term?
(defun embed-dag-as-term (dag interpreted-function-alist)
  `(dag-val-with-axe-evaluator ',dag
                                ,(make-acons-nest (dag-vars-unsorted dag))
                                ',(supporting-interpreted-function-alist (dag-fns dag) interpreted-function-alist t)
                                '0))

(defun embed-dags-as-terms (dags interpreted-function-alist)
  (if (endp dags)
      nil
    (cons (embed-dag-as-term (first dags) interpreted-function-alist)
          (embed-dags-as-terms (rest dags) interpreted-function-alist))))

;throws an error if it fails
;; Returns state
;handle defthm name clases?
(defun prove-embedded-dags-equal (dag1 dag2 hyps defthm-name interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (prove-theorem-with-axe-prover2 `(equal ,(embed-dag-as-term dag1 interpreted-function-alist)
                                          ,(embed-dag-as-term dag2 interpreted-function-alist))
                                  hyps defthm-name 3
                                  (list (make-rule-alist! (append '(iff-same equal-same)
                                                                 (lookup-rules))
                                                         (w state)))
                                  nil ;monitored-symbols
                                  interpreted-function-alist :brief
                                  nil ;options
                                  state))

;returns state
;handle defthm name clases?
(defun prove-embedded-dag-equalities (lhses rhses hyps defthm-names interpreted-function-alist print state)
  (declare (xargs :mode :program :stobjs state)
           (irrelevant print))
  (if (endp lhses)
      state
    (let ((state (prove-embedded-dags-equal (first lhses) (first rhses) hyps (first defthm-names) interpreted-function-alist state)))
      (prove-embedded-dag-equalities (rest lhses) (rest rhses) hyps (rest defthm-names) interpreted-function-alist print state))))

;i guess doesn't make sense to "duplicate" the lst parameter, since the producer function will still have to feed its result into that formal of the combined function
;i suppose a consumer could be allowed to mention only the length of the list (not its elements)?
;duplicating numcdrs is probably okay, since it starts at 0?
;; Returns (mv erp new-rune new-fn state).
;fn should be a nice tail-rec fn whose lst-formal is passed through unchanged and whose numcdrs-formal is incremented and is used in an nthcdr with lst
;fixme what if the function consumes more than 1 list?!
;the purpose of this is to split the numcdrs formal and/or the lst formal into two if necessary to accomodate ways those formals
;are used that do not fit the strict consumer pattern
;example: (TRANSFORM-FN-INTO-NICE-CONSUMER-FORM  'BVXOR-LIST-SPECIALIZED-TAIL-UNCDRED 'numcdrs 'y state)
(defun transform-fn-into-nice-consumer-form (fn
                                             numcdrs-formal ;a symbol
                                             lst-formal     ; a symbol
                                             interpreted-function-alist
                                             state)
  (declare (xargs :mode :program :stobjs state))
  (b* ((formals (fn-formals fn (w state)))
       (is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
       ;; (nice-tail-functionp (first is-a-nice-tail-function-result)) should always be true
       (exit-test-expr (second is-a-nice-tail-function-result))
       (base-case-expr (third is-a-nice-tail-function-result))
       (update-exprs (fourth is-a-nice-tail-function-result))
       (exit-test-expansion-defthm-name (packnew 'expansion-theorem-for- fn '-exit-test))
       (base-case-expansion-defthm-name (packnew 'expansion-theorem-for- fn '-base-case))
       (number-of-updates (len update-exprs))
       (update-numbers (ints-in-range 0 (+ -1 number-of-updates)))
       (update-expansion-defthm-names (packnew-list (pack$ 'expansion-theorem-for- fn '-update-) update-numbers state))
       ((mv erp exit-test-dag state)
        (get-dag-for-expr exit-test-expr exit-test-expansion-defthm-name interpreted-function-alist state))
       ((when erp) (mv erp nil nil state))
       ((mv erp base-case-dag state)
        (get-dag-for-expr base-case-expr base-case-expansion-defthm-name interpreted-function-alist state))
       ((when erp) (mv erp nil nil state))
       ((mv erp update-dags state)
        (get-dags-for-exprs update-exprs nil update-expansion-defthm-names interpreted-function-alist state))
       ((when erp) (mv erp nil nil state))
       (formal-update-dag-alist (pairlis$-fast formals update-dags))
       ;;the alist for formals other than the numcdrs and lst formals:
       (other-formal-update-dag-alist (remove-assoc-equal numcdrs-formal (remove-assoc-equal lst-formal formal-update-dag-alist)))
       (dags-to-check (cons exit-test-dag
                            (cons base-case-dag
                                  (strip-cdrs other-formal-update-dag-alist))))
       (replacement-alist (acons `(endp (nthcdr ,numcdrs-formal ,lst-formal)) ':fake
                                 (acons `(car (nthcdr ,numcdrs-formal ,lst-formal)) ':fake
                                        nil)))
       ((mv erp dags-to-check state)
        (replace-in-dags dags-to-check replacement-alist state))
       ((when erp) (mv erp nil nil state))
       ;; (exprs-after-removing-allowed-mentions (replace-in-terms2 exprs-to-check
       ;;                                                           (pairlis$-fast allowed-mentions
       ;;                                                                            '(:dummy :dummy))))
;         (need-to-duplicate-lst-formalp (member-eq lst-formal vars-remaining))
       )
    (if (not (member-eq numcdrs-formal (get-vars-from-dags dags-to-check))) ;(not need-to-duplicate-lst-formalp)
        (mv (erp-nil) nil nil state)
      ;;otherwise, at least one of the formals needs to be duplicated (for simplicity we'll duplicate them both? - fixme improve that):
;ffixme test this branch:
      (b* ((duplicate-numcdrs-formal (fresh-symbol (pack$ 'duplicate- numcdrs-formal) formals))
;             (duplicate-lst-formal (fresh-symbol (pack$ 'duplicate- lst-formal) (cons duplicate-numcdrs-formal formals)))
           (new-formals (cons duplicate-numcdrs-formal ;(cons duplicate-lst-formal
                              formals))                ;)
           ;;now we have to transform the various exprs to use the duplicate formals in the appropriate places
           ;;for each we'll first replace mentions of the numcdrs formal in okay uses with :fake-numcdrs
           ;;then replace all other uses with the duplicate name
           ;;then replace the :fake-numcdrs placeholder

           (placeholder-mentions `((endp (nthcdr :fake-numcdrs-formal ,lst-formal))
                                   (car (nthcdr :fake-numcdrs-formal ,lst-formal))))
           (allowed-mentions `((endp (nthcdr ,numcdrs-formal ,lst-formal))
                               (car (nthcdr ,numcdrs-formal ,lst-formal))))
           (put-in-placeholder-alist (pairlis$-fast allowed-mentions placeholder-mentions))
           (put-in-duplicate-names-alist (pairlis$-fast
                                          (list numcdrs-formal ;lst-formal
                                                )
                                          (list duplicate-numcdrs-formal ;duplicate-lst-formal
                                                )))
           (remove-placeholders-alist (pairlis$-fast
                                       (list :fake-numcdrs-formal ; :fake-lst-formal
                                             )
                                       (list numcdrs-formal ;lst-formal
                                             )))
           ;;handle the exit test:
           ((mv erp new-exit-test-dag state)
            (replace-in-dag exit-test-dag put-in-placeholder-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-exit-test-dag state)
            (replace-in-dag new-exit-test-dag put-in-duplicate-names-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-exit-test-dag state)
            (replace-in-dag new-exit-test-dag remove-placeholders-alist state))
           ((when erp) (mv erp nil nil state))
           ;;handle the base case:
           ((mv erp new-base-case-dag state)
            (replace-in-dag base-case-dag put-in-placeholder-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-base-case-dag state)
            (replace-in-dag new-base-case-dag put-in-duplicate-names-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-base-case-dag state)
            (replace-in-dag new-base-case-dag remove-placeholders-alist state))
           ((when erp) (mv erp nil nil state))
           ;;handle the updates:
           (other-formals (strip-cars other-formal-update-dag-alist))
           (other-formals-update-dags (strip-cdrs other-formal-update-dag-alist))
           ((mv erp new-other-formals-update-dags state)
            (replace-in-dags other-formals-update-dags put-in-placeholder-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-other-formals-update-dags state)
            (replace-in-dags new-other-formals-update-dags put-in-duplicate-names-alist state))
           ((when erp) (mv erp nil nil state))
           ((mv erp new-other-formals-update-dags state)
            (replace-in-dags new-other-formals-update-dags remove-placeholders-alist state))
           ((when erp) (mv erp nil nil state))
           (new-other-formals-update-dag-alist (pairlis$-fast other-formals new-other-formals-update-dags))
           ((mv erp dag-for-duplicate-numcdrs-formal) (dagify-term `(binary-+ '1 ,duplicate-numcdrs-formal)))
           ((when erp) (mv erp nil nil state))
           ((mv erp dag-for-numcdrs-formal) (dagify-term `(binary-+ '1 ,numcdrs-formal))) ;this is what was already there, except in dag form
           ((when erp) (mv erp nil nil state))
           ((mv erp dag-for-list-formal) (dagify-term lst-formal))
           ((when erp) (mv erp nil nil state))
           (full-formals-update-dag-alist
            (acons duplicate-numcdrs-formal dag-for-duplicate-numcdrs-formal
                   (acons numcdrs-formal dag-for-numcdrs-formal
                          (acons lst-formal dag-for-list-formal ;this is what was already there, except in dag form
                                 new-other-formals-update-dag-alist))))
           (new-update-dags-in-order (lookup-eq-lst new-formals full-formals-update-dag-alist))
           (new-fn (packnew fn '-with-duplicated-numcdrs-param-for-consumer))
           ;;fffixme can these calls to dag-to-term blow up?
           (new-exit-test-expr (embed-dag-as-term new-exit-test-dag interpreted-function-alist)) ;(dag2term new-exit-test-dag)
           (new-base-case-expr (embed-dag-as-term new-base-case-dag interpreted-function-alist)) ;(dag2term new-base-case-dag)
           (new-update-exprs (embed-dags-as-terms new-update-dags-in-order interpreted-function-alist)) ;(dags-to-terms new-update-dags-in-order)
           (defthm-name (packnew fn '--becomes-- new-fn))
           (exit-test-dags-agree-defthm-name (packnew defthm-name '-dags-agree-for-exit-test))
           (base-case-dags-agree-defthm-name (packnew defthm-name '-dags-agree-for-base-case))
           (update-dags-agree-defthm-names (packnew-list (pack$ defthm-name '-dags-agree-for-update-) update-numbers state))
           (exit-test-defthm-name (packnew defthm-name '-helper-for-exit-test))
           (base-case-defthm-name (packnew defthm-name '-helper-for-base-case))
           (increment-dags-defthm-name (packnew defthm-name '-helper-for-increments-dags))
           (state (prove-embedded-dags-equal dag-for-duplicate-numcdrs-formal dag-for-numcdrs-formal `((equal ,duplicate-numcdrs-formal ,numcdrs-formal))
                                             increment-dags-defthm-name interpreted-function-alist state))
           (state (prove-embedded-dags-equal exit-test-dag new-exit-test-dag `((equal ,duplicate-numcdrs-formal ,numcdrs-formal))
                                             exit-test-dags-agree-defthm-name interpreted-function-alist state))
           (state (submit-event-brief `(defthm ,exit-test-defthm-name
                                   (implies (equal ,numcdrs-formal ,duplicate-numcdrs-formal)
                                            (iff ,exit-test-expr
                                                 ,new-exit-test-expr))
                                   :rule-classes nil
                                   :hints (("Goal" :use ((:instance ,exit-test-dags-agree-defthm-name)
                                                         (:instance ,exit-test-expansion-defthm-name))
                                            :in-theory  (theory 'minimal-theory))))
                                state))
           (state (prove-embedded-dags-equal base-case-dag new-base-case-dag `((equal ,duplicate-numcdrs-formal ,numcdrs-formal))
                                             base-case-dags-agree-defthm-name interpreted-function-alist state))
           (state (submit-event-brief `(defthm ,base-case-defthm-name
                                   (implies (equal ,numcdrs-formal ,duplicate-numcdrs-formal)
                                            (equal ,base-case-expr
                                                   ,new-base-case-expr))
                                   :rule-classes nil
                                   :hints (("Goal" :use ((:instance ,base-case-dags-agree-defthm-name)
                                                         (:instance ,base-case-expansion-defthm-name))
                                            :in-theory  (theory 'minimal-theory))))
                                state))
           (state
;fixme just do it for the dags in new-other-formals-update-dag-alist?
;fixme put together the pieces for each update like we do just above for the exit and base?  the would leave less reasoning for the main theorem
            (prove-embedded-dag-equalities update-dags
                                           (rest new-update-dags-in-order) ;skip the update for the new formal
                                           `((equal ,duplicate-numcdrs-formal ,numcdrs-formal))
                                           update-dags-agree-defthm-names interpreted-function-alist :brief state))
           ;;fixme consider defining functions to capture the exit, base, and update dags (would need to open them up in the proof below)
           (state (submit-events-brief `(
                                   (skip-proofs ;fixme pull out the pattern of making a fn given the dags for each piece?
                                    (defun ,new-fn (,@new-formals)
                                      (declare (ignorable ,duplicate-numcdrs-formal) (xargs :normalize nil))
                                      (if ,new-exit-test-expr
                                          ,new-base-case-expr
                                        (,new-fn ,@new-update-exprs))))

                                   (defthm ,defthm-name
                                     (equal (,fn ,@formals)
                                            (,new-fn ,@(replace-in-terms2 new-formals (acons duplicate-numcdrs-formal numcdrs-formal nil))))
                                     :hints (("Goal" :do-not '(generalize eliminate-destructors)
                                              :induct (,new-fn ,@(replace-in-terms2 new-formals (acons duplicate-numcdrs-formal numcdrs-formal nil)))
                                              :expand ((,fn ,@formals)
                                                       (,new-fn ,@(replace-in-terms2 new-formals (acons duplicate-numcdrs-formal numcdrs-formal nil))))
                                              :in-theory (union-theories '(,fn ,new-fn) (theory 'minimal-theory)))
                                             (if stable-under-simplificationp ;better way to do this (we don't know what the goal names will be)?
                                                 '(:use (,@update-expansion-defthm-names
                                                         (:instance ,increment-dags-defthm-name (,duplicate-numcdrs-formal ,numcdrs-formal))
                                                         (:instance ,exit-test-defthm-name (,duplicate-numcdrs-formal ,numcdrs-formal))
                                                         (:instance ,base-case-defthm-name (,duplicate-numcdrs-formal ,numcdrs-formal))
                                                         ,@(cons-onto-all :instance (cons-all-onto update-dags-agree-defthm-names
                                                                                                   `((,duplicate-numcdrs-formal ,numcdrs-formal))))
                                                         )
                                                        :do-not '(generalize eliminate-destructors))
                                               nil))))
                                 state))
           ;; (- (cw "~x0 ~x1" defun defthm))
           )
        (mv (erp-nil)
            `,defthm-name
            new-fn
            state
           )))))

;dag should not be a quotep
(defun top-expr (dag)
  (cdr (first dag)))

(defun keep-keys-paired-with-quoted-zero (alist dag-array-name dag-array)
  (if (endp alist)
      nil
    (let* ((entry (car alist))
           (val (cdr entry)))
      (if (or (equal ''0 val)
              (and (integerp val)
                   (equal ''0 (aref1 dag-array-name dag-array val))))
          (cons (car entry)
                (keep-keys-paired-with-quoted-zero (cdr alist) dag-array-name dag-array))
        (keep-keys-paired-with-quoted-zero (cdr alist) dag-array-name dag-array)))))

;is this just make-alist?
(defun cons-list (x y)
  (if (endp x)
      nil
    (cons (cons (car x) (car y))
          (cons-list (rest x) (rest y)))))

(defun replace-in-each-term (terms var vals)
  (if (endp terms)
      nil
    (cons (replace-in-term2 (first terms) (acons var (first vals) nil))
          (replace-in-each-term (rest terms) var (rest vals)))))

;; Returns (mv erp dags).
(defun compose-terms-and-dags (terms var dags)
  (declare (xargs :mode :program))
  (if (endp terms)
      (mv (erp-nil) nil)
    (b* (((mv erp first-res) (compose-term-and-dag (first terms) var (first dags)))
         ((when erp) (mv erp nil))
         ((mv erp rest-res) (compose-terms-and-dags (rest terms) var (rest dags)))
         ((when erp) (mv erp nil)))
      (mv (erp-nil)
          (cons first-res rest-res)))))

;; Returns (mv erp result state) where result is (list new-runes new-fns).
(defun combine-producer-and-consumer (consumer-fn lst-formal numcdrs-formal producer-fn produced-formal dag-for-value-added-on interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (prog2$
   (cw "combining producer and consumer.  dag for value added on ~x0." dag-for-value-added-on)
   ;;may first need to transform the consumer (if it's numcdrs formal is used in other ways too
   (mv-let (erp transformer-rune transformed-consumer-fn state)
     (transform-fn-into-nice-consumer-form consumer-fn
                                           numcdrs-formal   ;a symbol
                                           lst-formal       ; a symbol
                                           interpreted-function-alist
                                           state)
     (if erp
         (mv erp nil state)
       (b* ((consumer-fn (or transformed-consumer-fn consumer-fn)) ;lst-formal and numcdrs-formal are still the same
            (consumer-formals (fn-formals consumer-fn (w state)))
            (consumer-is-a-nice-tail-function-result (is-a-nice-tail-function consumer-fn state)) ;   (nice-tail-recp (first is-a-nice-tail-function-result)) ;fixme check that this is t?!
            (consumer-exit-test-expr (second consumer-is-a-nice-tail-function-result))
            (consumer-base-case-expr (third consumer-is-a-nice-tail-function-result))
            (consumer-update-exprs (fourth consumer-is-a-nice-tail-function-result))

            (producer-formals (fn-formals producer-fn (w state)))
            (producer-is-a-nice-tail-function-result (is-a-nice-tail-function producer-fn state)) ;   (nice-tail-recp (first is-a-nice-tail-function-result)) ;fixme check that this is t?!
            (producer-exit-test-expr (second producer-is-a-nice-tail-function-result))
            ;; (producer-base-case-expr (third producer-is-a-nice-tail-function-result))
            (producer-update-exprs (fourth producer-is-a-nice-tail-function-result))
            ;;ffffixme handle name clashes between the formals
            ;;fixme switch to the versions that do generate theorems
            ((mv erp consumer-exit-test-dag state)
             (get-dag-for-expr-no-theorem consumer-exit-test-expr interpreted-function-alist state))
            ((when erp) (mv erp nil state))
            ;; (mv-let
            ;;  (consumer-base-case-dag state)
            ;;  (get-dag-for-expr-no-theorem consumer-base-case-expr interpreted-function-alist state)
            ((mv erp consumer-update-dags state)
             (get-dags-for-exprs-no-theorem consumer-update-exprs interpreted-function-alist nil state))
            ((when erp) (mv erp nil state))
            ;; (mv-let
            ;;  (producer-exit-test-dag state)
            ;;  (get-dag-for-expr-no-theorem producer-exit-test-expr interpreted-function-alist state)
            ;; (mv-let
            ;;  (producer-exit-test-dag state)
            ;;  (get-dag-for-expr-no-theorem producer-exit-test-expr interpreted-function-alist state)
            ((mv erp producer-update-dags state)
             (get-dags-for-exprs-no-theorem producer-update-exprs interpreted-function-alist nil state))
            ((when erp) (mv erp nil state))
            (consumer-formal-update-dag-alist (pairlis$ consumer-formals consumer-update-dags)) ;keeps the same order
            (producer-formal-update-dag-alist (pairlis$ producer-formals producer-update-dags)) ;keeps the same order
            (consumer-formal-update-dag-alist (clear-keys (list lst-formal numcdrs-formal)
                                                         consumer-formal-update-dag-alist))
            (producer-formal-update-dag-alist (remove-assoc-equal produced-formal producer-formal-update-dag-alist))
            (remaining-consumer-formals (strip-cars consumer-formal-update-dag-alist))
            (remaining-producer-formals (strip-cars producer-formal-update-dag-alist))
            (new-fn (packnew 'composition-of-- consumer-fn '--and-- producer-fn))
            (new-formals (append remaining-consumer-formals remaining-producer-formals))
            (term-for-value-added-on (embed-dag-as-term dag-for-value-added-on interpreted-function-alist))
            (replacement-alist (acons `(endp (nthcdr ,numcdrs-formal ,lst-formal))
                                      `(if ,producer-exit-test-expr 't 'nil)
                                      (acons `(car (nthcdr ,numcdrs-formal ,lst-formal))
                                             `(if ,producer-exit-test-expr
                                                  'nil ;in case we run out of arguments
                                                ,term-for-value-added-on)
                                             nil)))
            (remaining-consumer-formal-updates (strip-cdrs consumer-formal-update-dag-alist))
            ((mv erp new-consumer-exit-test-dag state)
             (replace-in-dag consumer-exit-test-dag replacement-alist state))
            ((when erp) (mv erp nil state))
            ((mv erp new-remaining-consumer-update-dags state)
             (replace-in-dags remaining-consumer-formal-updates replacement-alist state))
            ((when erp) (mv erp nil state))
            ;;fffixme should we fix up the base expr?

            ;;for each producer arg, we'll only update if the exit test is not true (so the producer exit test stays true once it becomes true)
            ;;each one is of the form (if (producer-exit-test producer-args) producer-arg (producer-update producer-args))
            (remaining-producer-formal-update-dags (strip-cdrs producer-formal-update-dag-alist))
            (number-of-remaining-producer-formals (len remaining-producer-formals))
            (term-to-compose `(if ,producer-exit-test-expr replace-me-formal replace-me-update-dag))
            (terms-to-compose (repeat number-of-remaining-producer-formals term-to-compose))
            (terms-to-compose (replace-in-each-term terms-to-compose 'replace-me-formal remaining-producer-formals))
            ((mv erp new-remaining-producer-formal-update-dags) (compose-terms-and-dags terms-to-compose 'replace-me-update-dag remaining-producer-formal-update-dags))
            ((when erp) (mv erp nil state))
            ;; (new-remaining-producer-formal-update-dags (cons-onto-all
            ;;                                             'if
            ;;                                             (cons-onto-all producer-exit-test-expr
            ;;                                                            (cons-list remaining-producer-formals
            ;;                                                                       (enlist-all remaining-producer-formal-update-dags)))))

            (defun `(skip-proofs ;fixme use whatever measure the consumer (possibly transformed-consumer) uses?
                     (defun ,new-fn (,@new-formals)
                       (declare (xargs :normalize nil))
                       (if ,(embed-dag-as-term new-consumer-exit-test-dag interpreted-function-alist)
                           ,consumer-base-case-expr
                         (,new-fn ,@(embed-dags-as-terms new-remaining-consumer-update-dags interpreted-function-alist)
                                  ,@(embed-dags-as-terms new-remaining-producer-formal-update-dags interpreted-function-alist))))))
            (defthm-name (packnew 'introduce- new-fn))
            (producer-call `(,producer-fn ,@producer-formals))
            (consumer-args (replace-in-terms2 consumer-formals
                                              (acons lst-formal producer-call
                                                     (acons numcdrs-formal ''0
                                                            nil))))
            (defthm `(skip-proofs ;fffffixme prove this!
                      (defthm ,defthm-name
                        (equal (,consumer-fn ,@consumer-args)
                               (,new-fn ,@new-formals)))))
            (state (submit-events-brief (list defun defthm) state)))
           (mv (erp-nil)
               (list (append (if transformer-rune (list transformer-rune) nil) (list `,defthm-name))
                     (append (if transformed-consumer-fn (list transformed-consumer-fn) nil) (list new-fn)))
               state))))))

;recognizes a nice tail rec function that returns a list which is built up using add-to-end
;returns (mv erp result state) where result is nil (if it's not a producer) or (list produced-formal dag-for-value-added-to-end)
;ex: (tail-rec-producer 'STREAM-BYTES-TAIL-NEW state)
;fixme destroys 'dag-array!
(defun tail-rec-producer (fn interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (let* ((is-a-nice-tail-function-result (is-a-nice-tail-function fn state)))
    (if (not (first is-a-nice-tail-function-result)) ;tells whether it is a nice tail function
        (mv (erp-nil) nil state)
      (b* ( ;(exit-test-expr (second is-a-nice-tail-function-result)) ;can this mention the list being produced?
           (base-case-expr (third is-a-nice-tail-function-result))
           (update-expr-list (fourth is-a-nice-tail-function-result))
           (formals (fn-formals fn (w state)))
           ((mv erp dag-for-base-case-expr state)
            (get-dag-for-expr-no-theorem base-case-expr interpreted-function-alist state))
           ((when erp) (mv erp nil state))
           (base-case-term (dag2term dag-for-base-case-expr)))
        (if (not (member-eq base-case-term formals)) ;a producer must return a single formal (fixme relax this restriction?)
            (mv (erp-nil) nil state)
          (b* ((formal-update-expr-alist (pairlis$-fast formals update-expr-list))
               (update-expr-for-returned-formal (lookup-eq base-case-term formal-update-expr-alist))
               ((mv erp update-dag-for-returned-formal state)
                (get-dag-for-expr-no-theorem update-expr-for-returned-formal interpreted-function-alist state))
               ((when erp) (mv erp nil state)))
            (if (and (not (quotep update-dag-for-returned-formal))
                     (call-of 'add-to-end (top-expr update-dag-for-returned-formal))
                     (eq base-case-term (lookup (farg2 (top-expr update-dag-for-returned-formal))
                                                update-dag-for-returned-formal)))
                (let* ((nodenum-or-quotep-for-value-added-on (farg1 (top-expr update-dag-for-returned-formal)))
                       (dag-for-value-added-on
                        (if (quotep nodenum-or-quotep-for-value-added-on)
                            nodenum-or-quotep-for-value-added-on
                          ;;fixme destroys 'dag-array! <-- old comment?
                          (drop-non-supporters (drop-nodes-past nodenum-or-quotep-for-value-added-on update-dag-for-returned-formal)))))
                  (if (member-eq base-case-term (dag-vars-unsorted dag-for-value-added-on))
                      ;;if the element produced depends on previous elements, it's not a producer in this sense (we can't get rid of the list argument when combining it with a consumer)
                      (mv (erp-nil) nil state)
                    (mv (erp-nil)
                        (list base-case-term
                              dag-for-value-added-on)
                        state)))
              (mv (erp-nil) nil state))))))))

;;returns (mv erp result state) where result is either nil or (list consumer-fn lst-formal numcdrs-formal producer-fn produced-formal dag-for-value-added-on)
(defun find-composition-of-producer-and-consumer (arg-nodenums-or-quoteps ;the args of a possible consumer.  this routine walks down these looking for a call of a producer
                                                  formals ;the formals of the possible consumer, in sync with arg-nodenums-or-quoteps
                                                  fn ;the possible consumer, known to be a nice tail rec fn
                                                  full-formal-arg-alist
                                                  miter-array-name miter-array interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp arg-nodenums-or-quoteps)
      (mv (erp-nil) nil state)
    (let ((arg-nodenum-or-quotep (first arg-nodenums-or-quoteps)))
      (if (quotep arg-nodenum-or-quotep)
          ;;keep looking:
          (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
        (let* ((possible-producer-expr (aref1 miter-array-name miter-array arg-nodenum-or-quotep)))
          (if (not (consp possible-producer-expr))
              ;;keep looking:
              (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
            (let ((possible-producer-fn (ffn-symb possible-producer-expr)))
              (if (not (first (is-a-nice-tail-function possible-producer-fn state)))
                  ;;keep looking:
                  (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
                ;;check whether it really is a producer:
                (mv-let (erp produced-result state)
                  (tail-rec-producer possible-producer-fn interpreted-function-alist state)
                  (if erp
                      (mv erp nil state)
                    (if (not produced-result)
                        ;;keep looking:
                        (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
                      ;;check whether the consumer really is a consumer for the value produced by the producer:
                      (mv-let
                        (erp numcdrs-formal state)
                        (tail-rec-consumer fn (first formals) interpreted-function-alist state)
                        (if erp
                            (mv erp nil state)
                          (if (not numcdrs-formal)
                              ;;keep looking:
                              (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
                            (let* ((arg-for-numcdrs-formal (lookup-eq numcdrs-formal full-formal-arg-alist)))
                              ;;make sure the numcdrs parameter of the consumer really begins at 0:
                              (if (not (equal ''0 arg-for-numcdrs-formal))
                                  ;;keep looking:
                                  (find-composition-of-producer-and-consumer (rest arg-nodenums-or-quoteps) (rest formals) fn full-formal-arg-alist miter-array-name miter-array interpreted-function-alist state)
                                (mv (erp-nil)
                                    (list fn
                                          (first formals)
                                          numcdrs-formal
                                          possible-producer-fn
                                          (first produced-result)
                                          (second produced-result))
                                    state)))))))))))))))))

;;looks for the composition of a consumer and a producer on one side of the miter
;; Returns (mv erp result state) where result is nil or (list new-runes new-fns).
(defun handle-producer-consumer-pattern-for-one-side (rec-fn-nodenums ;walks down this looking for a consumer (applied to a producer)
                                                      miter-array-name miter-array interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp rec-fn-nodenums)
      (mv (erp-nil) nil state)
    (let* ((possible-consumer-nodenum (first rec-fn-nodenums))
           (possible-consumer-expr (aref1 miter-array-name miter-array possible-consumer-nodenum)) ;will be a call of a rec fn
           (possible-consumer-fn (ffn-symb possible-consumer-expr)))
      (if (not (first (is-a-nice-tail-function possible-consumer-fn state)))
          ;;keep looking:
          (handle-producer-consumer-pattern-for-one-side (rest rec-fn-nodenums) miter-array-name miter-array interpreted-function-alist state)
        (mv-let (erp result state)
          (let* ((formals (fn-formals possible-consumer-fn (w state)))
                 (args (fargs possible-consumer-expr)))
            (find-composition-of-producer-and-consumer args
                                                       formals
                                                       possible-consumer-fn
                                                       (pairlis$-fast formals args)
                                                       miter-array-name miter-array interpreted-function-alist state))
          (if erp
              (mv erp nil state)
            (if result
                (prog2$ (cw "(Found producer/consumer pattern (info ~x0).)" result)
                        (combine-producer-and-consumer (first result) ;consumer-fn
                                                       (second result) ;lst-formal
                                                       (third result) ;numcdrs-formal
                                                       (fourth result) ;producer-fn
                                                       (fifth result) ;produced-formal
                                                       (sixth result) ;dag-for-value-added-on
                                                       interpreted-function-alist
                                                       state))
              ;;keep looking:
              (handle-producer-consumer-pattern-for-one-side (rest rec-fn-nodenums) miter-array-name miter-array interpreted-function-alist state))))))))

;returns (mv erp result state) where result is nil or (list new-runes new-fns)
(defun handle-producer-consumer-pattern (rec-fn-nodenums1 rec-fn-nodenums2 miter-array-name miter-array interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (mv-let (erp result state)
    (handle-producer-consumer-pattern-for-one-side rec-fn-nodenums1 miter-array-name miter-array interpreted-function-alist state)
    (if erp
        (mv erp nil state)
      (if result
          (mv (erp-nil) result state)
        (handle-producer-consumer-pattern-for-one-side rec-fn-nodenums2 miter-array-name miter-array interpreted-function-alist state)))))

;returns (mv erp dag-lst-or-quotep state)
(defun rewrite-to-expose-tuple-elements (dag-lst assumptions rewriter-rule-alist analyzed-function-table state)
    (declare (xargs :mode :program :stobjs state))
    (mv-let (runes-to-expose-tuple-elements state)
            (make-rules-to-expose-tuple-elements dag-lst analyzed-function-table nil state)
            (if runes-to-expose-tuple-elements
                (progn$
                 (cw "(Using rules to expose tuples: ~x0~%" runes-to-expose-tuple-elements)
;                 (cw "dag before:~%")
;                (print-list dag-lst)
                 (mv-let (erp dag-lst-or-quotep state)
                   (rewrite-dag dag-lst
                                :assumptions assumptions
                                :rule-alist (add-to-rule-alist! (append '(make-tuple-opener make-tuple-base)
                                                                       runes-to-expose-tuple-elements)
                                                               rewriter-rule-alist
                                                               (w state))
                                :print t
                                :monitored-symbols runes-to-expose-tuple-elements ;(strip-cadrs runes-to-expose-tuple-elements)
                                )
                   (if erp
                       (mv erp nil state)
                     (progn$ (cw ")~%") ; (cw "dag after:~%")
                             ;; (if dag-lst-or-quotep (print-list dag-lst-or-quotep) (cw "~x0" dag-lst-or-quotep))
                             (mv (erp-nil) dag-lst-or-quotep state)))))
              (mv (erp-nil) dag-lst state))))

;;only used for probable constants when things are pure? drop this?
;;returns (mv erp miter-nodenum-or-quotep dag-array dag-len state)
;;could return and use the auxiliary data structures?
(defun simplify-tree-and-add-to-dag-wrapper (tree
                                             dag-array ;must be named 'dag-array
                                             dag-len
                                             rewriter-rule-alist assumptions interpreted-function-alist monitored-symbols
                                             work-hard-when-instructedp print tag state)
  (declare (xargs :mode :program :stobjs state))
  (b* ( ;;Since we are not using the usual entry point to the rewriter we have to set up some stuff first:
       ((mv dag-parent-array dag-constant-alist dag-variable-alist)
        ;;fixme thread these aux parts of the dag through the sweeping and mitering code?
        (make-dag-indices 'dag-array dag-array 'dag-parent-array dag-len))
       (equality-assumption-alist (make-equality-assumption-alist assumptions (w state)))
       (refined-assumptions (refine-assumptions-for-matching assumptions (known-booleans (w state)) nil))
       ;;fixup the refined-assumptions to be fn calls applied to nodenums/quoteps:
       ((mv erp refined-assumption-exprs ;function calls applied to nodenums/quoteps in dag-array
            dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
        (add-refined-assumptions-to-dag-array refined-assumptions ;terms (must be function calls!  check this!)
                                              dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                                              'dag-array
                                              'dag-parent-array
                                              nil))
       ((when erp) (mv erp nil dag-array dag-len state))
       ((mv erp miter-nodenum-or-quotep dag-array dag-len & & & & info tries & state)
        (simplify-tree-and-add-to-dag tree
                                      dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
                                      rewriter-rule-alist
                                      (empty-trees-equal-to-tree)
                                      (make-refined-assumption-alist refined-assumption-exprs) ;Sat Jul 24 17:18:17 2010 this wasn't an alist!
                                      equality-assumption-alist
                                      nil    ;equality assumptions from context
                                      nil    ;print-interval
                                      :brief ;;nil ;; print
                                      nil    ;memoization
                                      (if (null print) (no-hit-counting) (if (eq :brief print) (zero-hits) (empty-hit-counts)))
                                      (and print (zero-tries))
                                      interpreted-function-alist
                                      monitored-symbols ;;just monitor the newest rules??
                                      0 ;embedded-dag-depth ;ffixme think this over
                                      work-hard-when-instructedp
                                      tag
                                      nil ;limits todo:support this?
                                      state))
       ((when erp) (mv erp nil dag-array dag-len state))
       (- (maybe-print-hit-counts info))
       (- (and tries (cw "(~x0 tries.)" tries)))
       )
    (mv (erp-nil) miter-nodenum-or-quotep dag-array dag-len state)))

;; Returns (mv erp simplified-conclusion defthm-name-or-nil state)
(defun simplify-conclusion (conclusion            ;a term
                            connections-of-inputs ;these are terms
                            hyps runes max-conflicts monitored-symbols conclusion-number rule-base fn-invars prover-rule-alist interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (and nil (call-of 'prefixp conclusion)) ;Mon Mar 14 03:56:09 2011 fixme get rid of this stuff
      (let* ((x (farg1 conclusion))
             (y (farg2 conclusion))
             (defthm-name (packnew rule-base conclusion-number))
             (equality-to-try `(equal ,x ,y)))
        ;; try to strengthen prefixp to equal; will work if the lengths of x and y are the same (fixme first try to simplify x and y, which will be components of the fn calls?? maybe not needed?)
        (mv-let (erp provedp state)
          (prove-theorem-with-axe-prover `(equal ,conclusion
                                                 ,equality-to-try)
                                         (append hyps connections-of-inputs)
                                         defthm-name max-conflicts
                                         ;;ffixme what other rules should be included?
                                         ;;we may need to open the invars of the individual functions
                                         ;;  (append prover-rules
                                         ;;                                                          (make-axe-rules (append '(prefixp-when-lens-equal
                                         ;;                                                                                 equal-of-prefixp-and-equal-work-hard
                                         ;;                                                                                 equal-of-equal-and-prefixp-work-hard
                                         ;;                                                                                 equal-of-prefixp-and-equal-work-hard-alt
                                         ;;                                                                                 equal-of-equal-and-prefixp-work-hard-alt
                                         ;;                                                                                 LEN-OF-NTHCDR-BETTER
                                         ;;                                                                                 equal-of-len-of-nthcdr-and-len
                                         ;;                                                                                 max)
                                         ;;                                                                               (wrap-all :definition fn-invars) ;may need to open these to use the fact that the exit test is true (that may imply something about the other params,.  for example, if exit-test is x=0 and an invar is x+y=oldx, then exi-test means y=oldx..
                                         ;;                                                                               (base-rules)
                                         ;;                                                                               runes)
                                         ;;                                                                       state))
                                         (list
                                          (add-to-rule-alist!
                                          (append '(prefixp-when-lens-equal
                                                    equal-of-prefixp-and-equal-work-hard
                                                    equal-of-equal-and-prefixp-work-hard
                                                    equal-of-prefixp-and-equal-work-hard-alt
                                                    equal-of-equal-and-prefixp-work-hard-alt
                                                    LEN-OF-NTHCDR-BETTER
                                                    equal-of-len-of-nthcdr-and-len
                                                    max)
                                                  fn-invars ;(wrap-all :definition fn-invars) ;may need to open these to use the fact that the exit test is true (that may imply something about the other params,.  for example, if exit-test is x=0 and an invar is x+y=oldx, then exit-test means y=oldx..
                                                  (base-rules)
                                                  runes)
                                          prover-rule-alist
                                          (w state)))
;monitored symbols:
                                         (cons 'equal-of-prefixp-and-equal monitored-symbols)
                                         interpreted-function-alist
                                         nil       ;print fixme?
                                         nil       ;options
                                         state)
          (if erp
              (mv erp nil nil state)
            (if provedp
                (mv nil equality-to-try defthm-name state)
              (mv nil conclusion nil state)))))
    ;;handle normally (fixme add other special cases?)
;fixme combine the simplification and the proof!
    (mv-let (erp simplified-dag state)
      (simp-term conclusion
                 :rules
                 runes ;todo: pre-compute the rule-alist?
                 :monitor monitored-symbols
                 :print t
                 :assumptions hyps
                 :check-inputs nil)
      (if erp
          (mv erp nil nil state)
        (let* ((simplified-conclusion (dag2term simplified-dag))
               (defthm-name (packnew rule-base conclusion-number))
               (state (submit-event-brief `(defthm ,defthm-name
                                       (implies ,(make-conjunction-from-list hyps)
                                                (equal ,conclusion
                                                       ,simplified-conclusion))
                                       :hints (("Goal"
                                                :in-theory (theory 'minimal-theory)
                                                :do-not '(generalize eliminate-destructors))
                                               (if stable-under-simplificationp
                                                   '(:clause-processor
                                                     (axe-prover ;analyzed-function table?
                                                      clause
                                                      ',(s :print t
                                                           (s :monitor monitored-symbols
                                                              (s :goal-name defthm-name
                                                                 (axe-prover-hints
                                                                  (append (base-rules)
                                                                          runes) ;what else do we need?!
                                                                  (empty-rule-alist)
                                                                  nil ;interpreted-function-alist ffixme?
                                                                  (empty-analyzed-function-table) ;fffixme
                                                                  ))))
                                                      state)
                                                     :do-not '(generalize eliminate-destructors))
                                                 nil))
                                       :rule-classes nil)
                                    state)))
          ;;fixme handle failure?
          (mv nil simplified-conclusion defthm-name state))))))

;; Returns (mv erp new-conclusions defthm-names state).
;rewriting the hyps with themselves may make things match better?
(defun simplify-conclusions (conclusions           ;terms
                             connections-of-inputs ;terms
                             hyps runes max-conflicts monitored-symbols new-conclusions-acc rule-names-acc conclusion-number rule-base fn-invars prover-rule-alist interpreted-function-alist state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp conclusions)
      (mv nil
          (reverse new-conclusions-acc)
          (reverse rule-names-acc)
          state)
    (let* ((conclusion (first conclusions))
           (dummy (cw "(Simplifying conclusion:~%~x0~%(Hyps:~%~x1)~%" conclusion hyps)))
      (declare (ignore dummy))
      (mv-let (erp simplified-conclusion defthm-name-or-nil state)
        (simplify-conclusion conclusion connections-of-inputs hyps runes max-conflicts monitored-symbols conclusion-number rule-base fn-invars prover-rule-alist interpreted-function-alist state)
        (if erp
            (mv erp nil nil state)
          (prog2$ (cw "Result of simplifying conclusion: ~x0)~%" simplified-conclusion)
                  (if defthm-name-or-nil
                      ;;we simplified this conclusion:
                      (simplify-conclusions (rest conclusions)
                                            connections-of-inputs hyps runes max-conflicts monitored-symbols
                                            (cons simplified-conclusion new-conclusions-acc)
                                            (cons defthm-name-or-nil rule-names-acc)
                                            (+ 1 conclusion-number) rule-base fn-invars prover-rule-alist interpreted-function-alist state)
                    (simplify-conclusions (rest conclusions)
                                          connections-of-inputs hyps runes max-conflicts monitored-symbols
                                          (cons conclusion new-conclusions-acc)
                                          rule-names-acc ;no rule to add
                                          (+ 1 conclusion-number) rule-base fn-invars prover-rule-alist interpreted-function-alist state))))))))


;; returns (mv erp dag state) where theorem-name has been proved in state and asserts that the term is equal to the dag
;fixme think about what vars may appear...
;fffffffixme use the assumptions?!
(defun simplify-term-and-prove-theorem (term theorem-name assumptions rule-alist interpreted-function-alist
                                             ;;fixme what other options to simplify-term?
                                             state)
  (declare (xargs :mode :program :stobjs state))
  (mv-let (erp dag state)
    (simp-term term
               :rule-alist
               rule-alist
               :interpreted-function-alist interpreted-function-alist
               :check-inputs nil)
    (if erp
        (mv erp nil state)
      (let ((state (submit-event-quiet ;pass in a quiet flag?
                    `(skip-proofs
                      ;;this is correct if the rewriter operates correctly:
                      (defthm ,theorem-name
                        (implies ,(make-conjunction-from-list assumptions)
                                 (equal ,term
                                        (dag-val-with-axe-evaluator ',dag
                                                                    ,(make-acons-nest (dag-vars-unsorted dag))
                                                                    ;;fixme think about this:
                                                                    ;;check that all the fns are already in interpreted-function-alist?
                                                                    ;;',interpreted-function-alist
                                                                    ;;is this overkill?
                                                                    ',(supporting-interpreted-function-alist
                                                                       (dag-fns dag)
                                                                       interpreted-function-alist
                                                                       t)
                                                                    '0 ;array depth (not very important)
                                                                    )))
                        :rule-classes nil))
                    state)))
        (mv nil dag state)))))

;; Returns (mv erp new-update-expr defthm-name updated-new-formal-in-terms-of-old-formals state) fffixme actually return a defthm (and handle in the caller!)
;;fixme just use the definition in the alist, rather than the one from state??
;;perhaps do other simplifications (e.g., open update functions and simplify the embedded dags)?
;;perhaps introduce lets?
;; fixme this should prove that, if the connection relation holds, then the new update function applied to the new formals is a particular subnest of the old update function applied to the old formals
(defun make-new-update-defun-for-formal (new-formal
                                         new-update-fn
                                         new-formals-in-terms-of-old-alist
                                         old-formals-in-terms-of-new-alist
                                         old-formal-update-expr-alist
                                         interpreted-function-alist
                                         possible-formals
                                         connection-relation-name
                                         connection-relation-formals
                                         state)
  (declare (xargs :stobjs state :verify-guards nil :mode :program))
  (b* ( ;a subnest (conses and nths) of the corresponding old formal (if the connection holds, this is equal to the old-formal?)
       (new-formal-in-terms-of-old-formals (lookup-eq-safe new-formal new-formals-in-terms-of-old-alist))

       ;;replace each old formal with its updated version (may replace several mentions):
       ;; if the connection holds, this is equal to the updated old-formal:
       (updated-new-formal-in-terms-of-old-formals (sublis-var-simple old-formal-update-expr-alist new-formal-in-terms-of-old-formals)) ;fixme what if this includes a dag?
       ;;replace the old formals with their expressions in terms of the new formals:
       ;; updated-new-formal-in-terms-of-new-formals essentially does the following:
       ;;   build the old-formals from the new formals, call the update function on the old formals, and build the new formal from the result
       (updated-new-formal-in-terms-of-new-formals (sublis-var-simple old-formals-in-terms-of-new-alist updated-new-formal-in-terms-of-old-formals))
       (defthm-name (packnew 'theorem-for- new-update-fn))
       (defthm `(defthm ,defthm-name
                  (implies (,connection-relation-name ,@connection-relation-formals)
                           (equal ,updated-new-formal-in-terms-of-new-formals
                                  ,updated-new-formal-in-terms-of-old-formals))
                  :rule-classes nil
                  :hints (("Goal" :in-theory  (union-theories (theory 'minimal-theory)
                                                              '(,connection-relation-name))))))
       (state (submit-event-brief defthm state))
       (- (cw "(simplifying the update for ~x0: ~x1~%" new-formal updated-new-formal-in-terms-of-new-formals))
       (fns-to-open (top-fns-of-terms ;;had strip-cars but that crashed on a variable
                     (strip-cdrs old-formal-update-expr-alist)))
       (fns-to-open (filter-user-fns-to-open fns-to-open interpreted-function-alist))
       (- (cw "fns to open: ~x0~%" fns-to-open))
       (defthm-2-name (packnew defthm-name '-two))
       )
    ;;fffixme make a version of the theorem above that has the simplified expression? then make a version that has the closed up call
    (mv-let (erp dag state)
      ;;submits the theorem defthm2-name
      (simplify-term-and-prove-theorem updated-new-formal-in-terms-of-new-formals
                                       defthm-2-name
                                       nil ;assumptions ;fixme pass in any invars?
                                       ;;fffixme simplify this expression more!
                                       ;; todo: use plain make-rule-alist here:
                                       (make-rule-alist! `(,@fns-to-open ;(wrap-all :definition fns-to-open)
                                                          nth-of-cons-constant-version ;fri mar  5 00:14:42 2010
                                                          lookup-equal-of-acons-diff
                                                          lookup-equal-of-acons-same
                                                          ) (w state))
                                       interpreted-function-alist
                                       state)
      (if erp
          (mv erp nil nil nil state)
        (progn$ (cw "(Simplified update dag for ~x0:~%" new-formal)
                (print-list dag) ;fixme write to file?
                (cw "))~%")
                (let* ((update-expr ;;if the dag has just one node that's a var, just put it in: (fixme what about a constant, or other small dags?)
                        (if (and ;nil ;ffffixme remove once we can handle this optimization...
                             (equal 1 (len dag))                 ;slow?
                             (equal 0 (car (car dag)))           ;just to check
                             (symbolp (cdr (car dag))))
                            (dag2term dag)
                          `(dag-val-with-axe-evaluator ',dag
                                                       ,(make-acons-nest (dag-vars-unsorted dag))
                                                       ',(supporting-interpreted-function-alist
                                                          (dag-fns dag) ;fixme think about this
                                                          interpreted-function-alist
                                                          t)
                                                       '0 ;array depth (not very important)
                                                       )))
                       (formals-mentioned (get-vars-from-term update-expr))
                       (ignored-formals (set-difference-eq possible-formals formals-mentioned)) ;fixme just drop some formals? might affect the callers
;fixme don't bother to make the defun if the expression is small?
                       (state (submit-event-brief `(defun ,new-update-fn (,@possible-formals)
                                               (declare (xargs :normalize nil))
                                               ,@(and ignored-formals `((declare (ignore ,@ignored-formals))))
                                               ,update-expr) state))
                       (defthm-3-name (packnew defthm-name '-three))
                       (state (submit-event-quiet `(defthm ,defthm-3-name ;quiet, since printing this can crash
                                                     (implies (,connection-relation-name ,@connection-relation-formals)
                                                              (equal (,new-update-fn ,@possible-formals)
                                                                     ,updated-new-formal-in-terms-of-old-formals))
                                                     :rule-classes nil
                                                     :hints (("Goal" :use ((:instance ,defthm-name) (:instance ,defthm-2-name))
                                                              :in-theory (union-theories (theory 'minimal-theory) '(,new-update-fn)))))
                                                  state)))
                  (mv nil
                      (cons new-update-fn possible-formals)
                      defthm-3-name
                      updated-new-formal-in-terms-of-old-formals ;fixme return the simplified version?
                      state)))))))


;; Returns (mv erp new-update-exprs defthm-names updated-new-formals-in-terms-of-old-formals state).
  ;;fixme just walk down new-formals-in-terms-of-old-alist? maybe the order is wrong..
(defun make-new-update-defuns (new-formals ;some may have been dropped
                               new-update-fns
                               new-formals-in-terms-of-old-alist ;pairs each new formal with a nest of conses and nths
                               old-formals-in-terms-of-new-alist
                               old-formal-update-expr-alist
                               interpreted-function-alist
                               possible-formals ;rename?
                               connection-relation-name
                               connection-relation-formals
                               state)
  (declare (xargs :stobjs state :verify-guards nil :mode :program))
  (if (endp new-formals)
      (mv nil nil nil nil state)
    (mv-let (erp new-update-expr first-defthm-name updated-new-formal-in-terms-of-old-formals state)
      (make-new-update-defun-for-formal (first new-formals) (first new-update-fns) new-formals-in-terms-of-old-alist old-formals-in-terms-of-new-alist
                                        old-formal-update-expr-alist interpreted-function-alist possible-formals connection-relation-name connection-relation-formals state)
      (if erp
          (mv erp nil nil nil state)
        (mv-let (erp new-update-exprs rest-defthm-names updated-new-formals-in-terms-of-old-formals state)
          (make-new-update-defuns (rest new-formals)
                                  (rest new-update-fns)
                                  new-formals-in-terms-of-old-alist old-formals-in-terms-of-new-alist old-formal-update-expr-alist
                                  interpreted-function-alist possible-formals connection-relation-name connection-relation-formals state)
          (if erp
              (mv erp nil nil nil state)
            (mv nil
                (cons new-update-expr new-update-exprs)
                (cons first-defthm-name rest-defthm-names)
                (cons updated-new-formal-in-terms-of-old-formals updated-new-formals-in-terms-of-old-formals)
                state)))))))

  ;; Returns (mv erp result new-runes new-fns new-fn analyzed-function-table state) where result is :error, :failed, or :success.  If result is :succcess, new-fns are the new function and its helper functions (exit, update, base, etc.), and new-runes contain the definitions of those functions as well as the equivalence lemma and invariant definition.
;fixme when making the invariant, make sure each conjunct can be relieved?
;fixme don't bother with candidate-invars that are not connected to the dropping process (in terms of being used in update functions or mentioned in invariants with something relevant - transitively, so we need a fixpoint)
  ;;fixme does or should this handle "old" values? if we can explain x in terms of y and old-y, we'll need to add old-y as a param in order to drop x.  but that seems like a win to me.. is this implemented now?
  ;; COMPONENT-EXPLANATION-EQUALITIES are equalities of the form (equal (nth '<component-num> <some-formal>) <expr>) where the exprs can include constants and other nth-of-params expressions (and old vars).  fixme allow replacement of a whole param!  maybe also of a smaller subterm?! do we do this now?
  ;; (Components are numbered starting at 0, so that nth works right.)
  ;;fffixme peel off base case before calling this function? maybe no need to, but may need to do it to the result of this function? we probably do now peel it off before calling this?
  ;;drops components of params, but not yet entire explainable params?! and what about components of components? old comment?
  ;;fixme what if we can explain the value of an array element? we don't want to build a cons nest as we would for a tuple...
  ;fixme can this still return :failed?
(defun drop-params-from-tail-function (fn ;the name of the function we're dropping params from
                                       component-explanation-equalities ;these have all been proved (components to be dropped may be expressed in terms of other components to drop, but there should be no circularity) ;old vars may appear in the RHSes
                                       update-preserves-invars-rule-symbols ;these are the proofs of the component-explanation-equalities
                                       proved-invars
                                       update-expr-list ;the expressions passed as arguments to the recursive call
                                       formal-update-expr-alist
                                       exit-test-expr
                                       negated-exit-test
                                       base-case-expr
                                       formal-shape-alist
                                       old-vars ;auxiliary vars mentioned in the invariant, e.g., "old" vars ;;these are from the hyps only!  not from unchanged stuff
                                       old-var-to-formal-alist
;rewriter-rule-alist
                                       prover-rule-alist ;drop?
;extra-stuff
                                       interpreted-function-alist
                                       formals
                                       analyzed-function-table
;unroll
;monitored-symbols print max-conflicts
                                       state)
  ;;fixme if an update-expr calls a function, should we simplify it? do we?
  ;;e.g., an update-fn with an embedded dag -- should we simplify that dag?
  (declare (xargs :mode :program :stobjs state))
  ;;some duplication here with another function?
  (b* ((- (cw "(Attempting to drop parameters from ~x0.~%" fn))
       (equivalence-lemma-name (packnew fn '--dropping-equivalence-lemma))
       (updates-preserve-invariant-theorem-name (packnew equivalence-lemma-name '-helper))
       (updates-preserve-connection-relation-theorem-name (packnew fn '-updates-preserve-connection-relation-for-dropping))
       (updates-preserve-connection-relation-theorem-name2 (packnew updates-preserve-connection-relation-theorem-name '-two))
       (- (cw "(formal-update-expr-alist: ~x0)~%" formal-update-expr-alist))
       (invariant-name (packnew fn '-invariant))
       (vars-in-inductive-invars (get-vars-from-terms proved-invars))
       (formals-in-invar (intersection-eq formals vars-in-inductive-invars)) ;puts them in the same order as formals
       (old-vars-in-invar (intersection-eq old-vars vars-in-inductive-invars))
       ;; Define the invariant: ;fixme pull this out of this function?
       (state (submit-events-brief `((defun ,invariant-name (,@formals-in-invar ,@old-vars-in-invar)
                                 (declare (xargs :normalize nil))
                                 (and ,@proved-invars))

                               ;;Proves that the updates to the params preserve the entire invariant (easy since we know they preserve each piece):
                               (defthm ,updates-preserve-invariant-theorem-name
                                 (implies (and ,negated-exit-test
                                               (,invariant-name ,@formals-in-invar ,@old-vars-in-invar))
                                          (,invariant-name ,@(lookup-eq-lst formals-in-invar formal-update-expr-alist) ,@old-vars-in-invar))
                                 :rule-classes nil
                                 :hints (("goal" :in-theory (union-theories (theory 'minimal-theory) '(,invariant-name))
                                          :do-not '(generalize eliminate-destructors)
                                          :use (,@update-preserves-invars-rule-symbols)))))
                             state))
       ;;Now handle the dropping of the params:
       ;;we have expressions over the formals, and we need to fix them up to be over the new formals
       (components-to-drop (strip-cadrs component-explanation-equalities)) ;the LHSes of the equalities
       (component-replacements (strip-caddrs component-explanation-equalities)) ;the RHSes of the equalities

       ;;handle old-vars in the explanations:
       ;;they will have to be added to the new function as parameters
       (vars-in-explanations (get-vars-from-terms component-replacements))
       (old-vars-in-explanations (intersection-eq old-vars vars-in-explanations)) ;sorts and removes dups  ;should we add new- to these names for consistency?
       (- (cw "(Old vars in explanations: ~x0)~%" old-vars-in-explanations))

       (- (cw "Dropping components: ~x0 from function ~x1.~%" components-to-drop fn))
       (component-replacement-alist (pairlis$ components-to-drop component-replacements))
;we take the closure of the alist, in case x is expressed in terms of y, which is in turn expressed in terms of z, etc.:
;the cdrs of this should be in terms of params that are to be kept
;any component disjoint from all the keys of this alist is to be kept:
       (component-replacement-alist (closure-of-replacement-alist component-replacement-alist)) ;expresses some components of the formals in terms of the formals
       (- (cw "component-replacement-alist: ~x0~%" component-replacement-alist))
;fixme can we reuse the same formal names? will require changes to all manually given annotations in the examples
       (new-formal-names (my-pack-list 'new- formals)) ;ffixme watch for name clash with a formal named new-xxx ;ffixme some of these may be dropped..
       (new-formal-name-to-old-formal-name-alist (pairlis$-fast new-formal-names formals))
       ;;pair each kept-component of the old formals with its expr over the new formals (component nums may be adjusted down):
       (kept-component-renaming-alist (kept-component-renaming-alist2 formals new-formal-names formal-shape-alist component-replacement-alist nil))
       (- (cw "kept-component-renaming-alist for ~x0:~%~x1~%" fn kept-component-renaming-alist))
       ;;pair each dropped-component with its expression over the new formals:
       (dropped-component-renaming-alist (dropped-component-renaming-alist component-replacement-alist kept-component-renaming-alist nil))
       (- (cw "dropped-component-renaming-alist for ~x0:~%~x1~%" fn dropped-component-renaming-alist))

       ;; pair each old formal with its expression over the new formals:
;(formal-replacement-terms (formal-replacement-terms formals formal-length-alist kept-component-renaming-alist dropped-component-renaming-alist))
       (old-formals-in-terms-of-new (formal-replacement-terms2 formals formal-shape-alist kept-component-renaming-alist dropped-component-renaming-alist))
       (old-formals-in-terms-of-new-alist (pairlis$ formals old-formals-in-terms-of-new))
       (- (cw "old-formals-in-terms-of-new-alist: ~x0~%" old-formals-in-terms-of-new-alist))

       ;;together, the keys of this should represent all components of all the new formals:
       ;; (new-components-in-terms-of-old-alist (reverse-alist kept-component-renaming-alist))
       ;; (new-formals-in-terms-of-old (express-new-params-in-terms-of-old new-formal-names new-components-in-terms-of-old-alist))
       ;; (new-formals-in-terms-of-old-alist (pairlis$ new-formal-names new-formals-in-terms-of-old))
       (new-formals-in-terms-of-old-alist (new-formals-in-terms-of-old-alist formals new-formal-names formal-shape-alist component-replacement-alist nil)) ;doesn't include old-vars-in-explanations
       (- (cw "new-formals-in-terms-of-old-alist: ~x0~%" new-formals-in-terms-of-old-alist))

       (new-formals (strip-cars new-formals-in-terms-of-old-alist)) ;may not be all of the new-formals above (some formals may be dropped) ;doesn't include old-vars-in-explanations
       ;;(new-formals (intersection-eq (my-pack-list 'new- formals) new-formals)) ;fixme add this and test!

       (new-formals-in-terms-of-old
        (strip-cdrs new-formals-in-terms-of-old-alist)) ;doesn't include old-vars-in-explanations
;(test-cases-for-new-and-old-formals (add-test-cases-for-new-formals2 new-formals-in-terms-of-old-alist test-cases-for-formals-and-old-vars nil))

       ;;over the new formals (including orig vars):
       (new-base-case-expr (sublis-var-simple old-formals-in-terms-of-new-alist base-case-expr)) ;has the same shape as the old base case

       (new-fn (packnew fn '-new))
       (fns-equal-theorem-name (packnew fn '--becomes-- new-fn))
       (fns-equal-helper-theorem-name (packnew fns-equal-theorem-name '-helper))
       (fns-equal-helper2-theorem-name (packnew fns-equal-theorem-name '-helper2))
       (fns-equal-helper2b-theorem-name (packnew fns-equal-theorem-name '-helper2b))
       (fns-equal-helper3-theorem-name (packnew fns-equal-theorem-name '-helper3))
       (fns-equal-helper4-theorem-name (packnew fns-equal-theorem-name '-helper4))

       (connection-equalities (make-connection-equalities3 formals old-formals-in-terms-of-new))
       (- (cw "Connection equalities: ~x0~%" connection-equalities))
       (connection-relation-name (packnew fn '-and- new-fn '-connection-relation))
       (connection-relation-formals (append formals new-formals old-vars-in-explanations))
       (state (submit-event-brief
               `(defun ,connection-relation-name (,@connection-relation-formals)
                  (declare (xargs :normalize nil))
                  (and ,@connection-equalities))
               state))

       ;;over the new formals (including orig vars):
       (new-exit-test-expr (sublis-var-simple old-formals-in-terms-of-new-alist exit-test-expr))

       ;;Proves that the new-exit-test-expr is right:
       (exit-tests-equal-helper-1-lemma-name (packnew fn '-exit-tests-equal-helper-1))
       (state (submit-event-brief `(defthm ,exit-tests-equal-helper-1-lemma-name
                               (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar) ;is this needed?
                                             (,connection-relation-name ,@connection-relation-formals))
                                        (iff ,exit-test-expr
                                             ,new-exit-test-expr))
                               :rule-classes nil
                               :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                          '(,invariant-name ;leave closed?
                                                                            ,connection-relation-name)))))
                            state))


       ;;Simplify the exit test (by expanding the function), if needed:

       ;;if the original exit test was just a call of a user fn on some params:
       ;;new-exit-test will be a call of the same fun on some args (probably not formals)
       (exit-test-is-a-simple-callp (and (consp exit-test-expr)
                                         (not (member-eq (ffn-symb exit-test-expr) *built-in-fns*))
                                         (symbol-listp (fargs exit-test-expr))
                                         (subsetp-eq (fargs exit-test-expr) formals)))

       ;;expand the body of the new-exit-test-expr
       ;;this is over the formals:
       (expanded-new-exit-test-expr (if (not exit-test-is-a-simple-callp)
                                        new-exit-test-expr
                                      (let* ((new-exit-test-fn (ffn-symb new-exit-test-expr))
                                             (new-exit-test-fn-body (fn-body new-exit-test-fn t (w state)))
                                             (new-exit-test-fn-formals (fn-formals new-exit-test-fn (w state))))
                                        (sublis-var-simple (pairlis$ new-exit-test-fn-formals
                                                                   (fargs new-exit-test-expr))
                                                       new-exit-test-fn-body))))
       ;;fixme prove (equal expanded-new-exit-test-expr new-exit-test-expr) right here..
       ;;fixme add parens and an explanation around this operation:
       ;;fixme this should return a theorem:
       ((mv erp simplified-expanded-new-exit-test-expr-dag state)
        (simp-term expanded-new-exit-test-expr
                   :rules
                   (exit-test-simplification-rules) ;;ffixme more rules!
                   :print t                         ;fixme?
                   :monitor '() ;;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger ;;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger-alt
                   :assumptions nil ;;use something here?
                   :normalize-xors nil
                   :check-inputs nil))
       ((when erp)
        (mv erp nil nil nil nil nil state))
       (simplified-expanded-new-exit-test-expr (dag2term simplified-expanded-new-exit-test-expr-dag)) ;do the equivalence proof of this sooner? make a simplify-and-prove function?
       ;;new-formals is a slightly deceptive name, since it doesn't include the old vars
;fffffffixme check for name clashes
       (new-update-fns ;(make-var-names (pack$ new-fn '-update-) (len new-formals))  ;may not all be used?? ;also, no update fns for orig vars
        (packnew-list (pack$ new-fn '-update-) (ints-in-range  0 (+ -1 (len new-formals))) state))
       ;;Make the new update expressions (the shapes of need to change, and they need to be fixed up to refer to the new params):
       ;;fixme for any of these that is just trivial (returns a param or a constant), or doesn't have any shared nodes??, don't make and call the defun?
       ;;fixme do this above when we generate the update exprs?
       ((mv erp new-update-exprs update-fn-defthms updated-new-formals-in-terms-of-old-formals state)
        ;;this does simplification too:
        (make-new-update-defuns new-formals ;some may have been dropped
                                new-update-fns
                                new-formals-in-terms-of-old-alist ;pairs each new formal with a nest of conses and nths
                                old-formals-in-terms-of-new-alist
                                formal-update-expr-alist
                                interpreted-function-alist
                                (append new-formals old-vars-in-explanations)
                                connection-relation-name
                                connection-relation-formals
                                state))
       ((when erp)
        (mv erp nil nil nil nil nil state))
       (exit-tests-equal-helper-2-lemma-name (packnew fn '-exit-tests-equal-helper-2))
       (exit-tests-lemma-name (packnew fn '-exit-tests-equal))
       (base-cases-lemma-name (packnew fn '-base-cases-equal))
       (induction-fn-name (packnew fn '-and- new-fn '-joint-induct))

       (new-exit-fn (packnew new-fn '-exit-test))

       ;;will a later pass peel off the new-base-fn?
       ;;`(,new-base-fn ,@new-formals ,@old-vars-in-explanations)

       ;;the called functions are defined below:
       (new-fn-body `(if (,new-exit-fn ,@new-formals ,@old-vars-in-explanations)
                         ,new-base-case-expr
                       (,new-fn ,@new-update-exprs ,@old-vars-in-explanations)))

       ;;                            ;;(param-relation-after-update (replace-in-terms2 param-replacement-equalities
       ;;                            ;;(acons 'params `(,update-fn params)
       ;;                            ;;(acons 'new-params `(,new-update-fn new-params)
       ;;                            ;;nil))))
       ;;                            (param-relation-for-whole-fns
       ;;                             (replace-in-terms2 param-replacement-equalities
       ;;                                                (acons 'params `(,fn params)
       ;;                                                       (acons 'new-params `(,new-fn ,term-for-new-params2)
       ;;                                                              nil))))
       ;;                            (param-replacement-equalities-substituted
       ;;                             (replace-in-terms2 param-replacement-equalities
       ;;                                                (acons 'new-params term-for-new-params2 nil)))
       ;;                            ;;(induction-fn-name (packnew fn '-and- new-fn '-joint-induct))

       (original-names-of-new-formals (lookup-eq-lst new-formals new-formal-name-to-old-formal-name-alist))
       (state
        (submit-events-brief `( ;rename the formals of these (will have to change all annotations):
                         (defun ,new-exit-fn (,@original-names-of-new-formals ,@old-vars-in-explanations) ;fixme figure out which formals are needed?
                           (declare (ignorable ,@original-names-of-new-formals ,@old-vars-in-explanations) (xargs :normalize nil)) ;Thu Mar 11 23:12:52 2010
                           ,(replace-in-term2 simplified-expanded-new-exit-test-expr new-formal-name-to-old-formal-name-alist))

                         ;; ;;fixme if it's trivial, we don't need this function (will require a peel off step..) maybe it won't be trivial, because it needs to express the dropped param in terms of others?  but maybe the dropped formal isn't returned..
                         ;; (defun ,new-base-fn (,@new-formals ,@old-vars-in-explanations) ;fixme figure out which formals are needed?
                         ;;   (declare (ignorable ,@new-formals ,@old-vars-in-explanations) (xargs :normalize nil))
                         ;;   ,new-base-case-expr)

                         ;;the new function:
                         (skip-proofs
                          (defun ,new-fn (,@original-names-of-new-formals ,@old-vars-in-explanations)
                            (declare (xargs :normalize nil)) ;may be needed if exit test is t -- ffixme where else should we use normalize nil??
                            ,(replace-in-term2 new-fn-body new-formal-name-to-old-formal-name-alist)))

;fixme call prove-theorem! better yet, use the theorems proved above..
                         (defthm ,exit-tests-equal-helper-2-lemma-name
                           (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                         (,connection-relation-name ,@connection-relation-formals))
                                    (iff ,new-exit-test-expr
                                         ,simplified-expanded-new-exit-test-expr)) ;fffixme i saw a case where simplified-expanded-new-exit-test-expr was t!
                           :rule-classes nil
                           :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                      '(,new-exit-fn ,invariant-name ,connection-relation-name)))
                                   (if stable-under-simplificationp
                                       '(:clause-processor
                                         (axe-prover
                                          clause
                                          ',(s :goal-name exit-tests-equal-helper-2-lemma-name
                                               (s :print t
                                                  (axe-prover-hints
                                                   (append ;the are new (fixme just have the simplification return a lemma and use it here!)
                                                    '(equal-cons-cases2
                                                      equal-cons-cases2-alt
                                                      EQUAL-OF-NIL-AND-CDR
                                                      len-of-cdr ; LIST::LEN-OF-CDR-BETTER
                                                      )
                                                    (exit-test-simplification-proof-rules))
                                                   ;;ffixme this causes a lot of printing!!
                                                   prover-rule-alist ;do we want all of these?  do we want the other dag prover runes from the table?
                                                   nil ;interpreted-function-alist
                                                   analyzed-function-table)))
                                          state)
                                         :do-not '(generalize eliminate-destructors))
                                     nil)))

                         (defthm ,exit-tests-lemma-name
                           (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                         (,connection-relation-name ,@connection-relation-formals))
                                    (iff ,exit-test-expr
                                         (,new-exit-fn ,@new-formals ,@old-vars-in-explanations)))
                           :rule-classes nil
                           :hints (("Goal"
                                    :use (,exit-tests-equal-helper-1-lemma-name
                                          ,exit-tests-equal-helper-2-lemma-name)
                                    :in-theory (union-theories (theory 'minimal-theory)
                                                               '(,new-exit-fn)))))

                         (defthm ,base-cases-lemma-name
                           (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                         (,connection-relation-name ,@connection-relation-formals))
                                    (equal ,base-case-expr
                                           ,new-base-case-expr))
                           :rule-classes nil
                           :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                      '(,invariant-name
                                                                        ;;,new-base-fn ;why?
                                                                        ,connection-relation-name))))))
                       state))
       (update-expr-alist ;for the old and new formals
        (append ;(pairlis$ old-vars-in-explanations old-vars-in-explanations) ;the updates are no-ops for these, do drop this?
         formal-update-expr-alist
         (pairlis$ new-formals new-update-exprs)))

       ;;                                        ;;for each connection conjunct, prove that the updates preserve it
       ;;                                        ;;fffixme isn't this easy, given that the connections are included in the proved invariant?
       ;;                                        ;;ffffixme just use update-preserves-invars-rule-symbols? prove that the invar implies the connection-equalities?
       ;;                                        ;;fffixme each of these may need a hyp about the length of the update fn's RV?:
       ;;                                        (prove-updates-preserve-connection-for-dropping (sublis-var-simple-lst update-expr-alist connection-equalities) ;replaces all old and new params by their updated versions
       ;; ;hyps to use:
       ;;                                                                                        proved-invars
       ;;                                                                                        connection-equalities
       ;;                                                                                        `(,connection-relation-name ,@connection-relation-formals)
       ;;                                                                                        `( ;(,invariant-name ,@(sublis-var-simple-lst update-expr-alist formals-in-invar) ,@old-vars-in-invar) ;we assume the invariant both before and after the update?: yuck? might get in the way? ;trying without this

       ;;                                                                                          ,negated-exit-test ;open this?
       ;;                                                                                          )
       ;;                                                                                        fn
       ;;                                                                                        0 ;;conjunct-number
       ;;                                                                                        invariant-name
       ;;                                                                                        `(,invariant-name ,@formals-in-invar ,@old-vars-in-invar) ;bind in a let?
       ;;                                                                                        connection-relation-name
       ;;                                                                                        new-update-fns
       ;;                                                                                        analyzed-function-table
       ;;                                                                                        (extend-rule-alist (make-axe-rules `(,connection-relation-name
       ;;                                                                                                                          ,invariant-name
       ;;                                                                                                                          ;;,(pack$ fn '-leibniz) ;add this?
       ;;                                                                                                                          ,@(wrap-all :definition new-update-fns) ;shouldn't need this?
       ;;                                                                                                                          )
       ;;                                                                                                                        state)
       ;;                                                                                                           t ; remove-duplicate-rulesp
       ;;                                                                                                           (table-alist 'axe-rule-priorities-table (w state)) ;okay?
       ;;                                                                                                           rewriter-rule-alist)
       ;;                                                                                        ;;gross to need to do all this list reasoning:
       ;;                                                                                        ;; use a use hint?
       ;;                                                                                        ;; ,@(append (list-rules-etc) (list-rules2-executable-counterparts))
       ;;                                                                                        (extend-rule-alist (make-axe-rules `(,connection-relation-name
       ;;                                                                                                                          ,invariant-name
       ;;                                                                                                                          ;;,(pack$ fn '-leibniz) ;add this?
       ;;                                                                                                                          ,@(wrap-all :definition new-update-fns))
       ;;                                                                                                                        state)
       ;;                                                                                                           t ; remove-duplicate-rulesp
       ;;                                                                                                           (table-alist 'axe-rule-priorities-table (w state)) ;okay?
       ;;                                                                                                           prover-rule-alist)
       ;;                                                                                        test-cases-for-new-and-old-formals
       ;;                                                                                        (add-fns-to-interpreted-function-alist `(,invariant-name ;needed to see which tests satisfy the hyps (it they all will, don't check?)
       ;;                                                                                                                            ,connection-relation-name
       ;;                                                                                                                            ,new-fn ,new-exit-fn ,new-base-fn ,@new-update-fns)
       ;;                                                                                                                          interpreted-function-alist state)
       ;;                                                                                        unroll print extra-stuff monitored-symbols miter-depth-to-use nil state)

       (state (submit-events-brief `((defthm ,updates-preserve-connection-relation-theorem-name
                                 (implies (and (,invariant-name ,@(sublis-var-simple-lst update-expr-alist formals-in-invar) ,@old-vars-in-invar)
                                               ;;(,invariant-name ,@formals-in-invar ,@old-vars-in-invar) ;to get the shape info?
                                               ;;(,connection-relation-name ,@formals ,@new-formals ,@old-vars-in-explanations) ;can we leave this closed?
                                               ;;,negated-exit-test
                                               ) ;open this manually? and close up in the next theorem?
                                          (,connection-relation-name ,@update-expr-list ,@updated-new-formals-in-terms-of-old-formals ,@old-vars-in-explanations))
                                 :rule-classes nil
                                 :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                            '(,connection-relation-name
                                                                              ,invariant-name
                                                                              ;;min
                                                                              nth-of-cons-constant-version
                                                                              equal-of-cons-of-nth-0-same
                                                                              equal-of-nthcdr-and-nth-same
                                                                              CONSP-OF-NTHCDR
                                                                              equal-of-nthcdr-and-cons
                                                                              equal-of-cons-when-equal-nth-0
                                                                              NTHCDR-IFF
                                                                              ,@(list-rules2)
                                                                              ,@(subrange-rules)
                                                                              ,@(list-rules2-executable-counterparts)))
                                          ;;i guess because of substitution, this may not be reliable:
                                          ;;:expand ((,connection-relation-name ,@update-expr-list ,@new-update-exprs ,@old-vars-in-explanations))
                                          :use ( ;,updates-preserve-invariant-theorem-name
                                                ;;,@update-fn-defthms ;could use these as rewrites if we first subst in the old vars for the new vars
                                                ;;,@defthm-names
                                                )
                                          :do-not '(generalize eliminate-destructors))))

                               (defthm ,updates-preserve-connection-relation-theorem-name2
                                 (implies (and (,invariant-name ,@(sublis-var-simple-lst update-expr-alist formals-in-invar) ,@old-vars-in-invar)
                                               ;;(,invariant-name ,@formals-in-invar ,@old-vars-in-invar) ;to get the shape info?
                                               (,connection-relation-name ,@formals ,@new-formals ,@old-vars-in-explanations)
                                               ;;,negated-exit-test
                                               ) ;open this manually? and close up in the next theorem?
                                          (,connection-relation-name ,@update-expr-list ,@new-update-exprs ,@old-vars-in-explanations))
                                 :rule-classes nil
                                 :hints (("Goal" :in-theory (theory 'minimal-theory)
                                          :use (,updates-preserve-connection-relation-theorem-name
                                                ,@update-fn-defthms ;could use these as rewrites if we first subst in the old vars for the new vars
                                                )
                                          :do-not '(generalize eliminate-destructors))))

                               ,(make-induction-function2 fn new-fn (append new-formals old-vars-in-explanations) new-fn-body induction-fn-name state)

                               ;;Prove by induction that fn and new-fn are equal, given the invariant and the connection:
                               (defthm ,fns-equal-helper-theorem-name
                                 (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                               (,connection-relation-name ,@formals ,@new-formals ,@old-vars-in-explanations))
                                          (equal (,fn ,@formals)
                                                 (,new-fn ,@new-formals ,@old-vars-in-explanations)))
                                 :rule-classes nil
                                 :hints (("Goal"
                                          ;;fffixme what about name clashes between the formals?
;ffixme can we use a generic result here, even though the arities of the functions may be different in different cases?
                                          :induct (,induction-fn-name ,@formals ,@new-formals ,@old-vars-in-explanations)
                                          ;;                                   :use
                                          ;;                                   ((:instance
                                          ;;                                     (:functional-instance
                                          ;;                                      generic-connection-relation-holds
                                          ;;                                      (generic-tail1-update ,update-fn)
                                          ;;                                      (generic-tail2-update ,new-update-fn)
                                          ;;                                      (generic-tail1-exit ;,exit-fn
                                          ;;                                       (lambda (params) ,exit-test-body)
                                          ;;                                       )
                                          ;;                                      (generic-tail2-exit ,new-exit-fn)
                                          ;;                                      (generic-tail1 ,fn)
                                          ;;                                      (generic-tail2 ,new-fn)
                                          ;;                                      ;; (generic-tail1-pred ,invariant-name)
                                          ;;                                      (generic-tail1-pred (lambda (params) (,invariant-name params ,@old-vars)))
                                          ;;                                      (generic-connection-relation ,connection-relation-name))))
                                          :do-not '(generalize eliminate-destructors)
                                          :in-theory (union-theories
                                                      '(,fn ,induction-fn-name ,new-fn)
                                                      (theory 'minimal-theory)))
                                         (if stable-under-simplificationp ;better way to do this (we don't know what the goal names will be)?
                                             '(:use
                                               (,updates-preserve-connection-relation-theorem-name2
                                                ,base-cases-lemma-name
                                                ,exit-tests-lemma-name
                                                ,updates-preserve-invariant-theorem-name
                                                )
                                               :do-not '(generalize eliminate-destructors))
                                           nil)))

                               ;;this just gets rid of the new-formals:
                               ;;could simplify nth of cons in the hyp?
                               (defthm ,fns-equal-helper2-theorem-name
                                 (implies (and (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                               (,connection-relation-name ,@formals ,@new-formals-in-terms-of-old ,@old-vars-in-explanations))
                                          (equal (,fn ,@formals)
                                                 (,new-fn ,@new-formals-in-terms-of-old ,@old-vars-in-explanations)))
                                 :rule-classes nil
                                 :hints (("Goal" :use (:instance ,fns-equal-helper-theorem-name
                                                                 ,@(make-alist-into-bindings new-formals-in-terms-of-old-alist))
                                          :in-theory (theory 'minimal-theory))))

                               ;;helps us drop the connection relation:
;fixme do we ever need the invariant here? yes, we need type information (len of params, etc.) - but unchanged params may get in the way?
                               ;;this one is new! rename? do earlier?
                               (defthm ,fns-equal-helper2b-theorem-name
                                 (implies (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                          (,connection-relation-name ,@formals ,@new-formals-in-terms-of-old ,@old-vars-in-explanations))
                                 :rule-classes nil
                                 :hints (("Goal" :use (:instance ,fns-equal-helper2-theorem-name)
                                          :in-theory (union-theories '(,invariant-name
                                                                       ,connection-relation-name
                                                                       ,@(append (list-rules2)
                                                                                 (subrange-rules)
                                                                                 (list-rules2-executable-counterparts)) ;fixme why are we using these?
                                                                       ;;i found a case where we needed to prove (EQUAL (SUBRANGE 5 9 PARAMS) (FIRSTN 5 (NTHCDR 5 PARAMS)))
                                                                       ;;add some rules to list-rules-etc?
                                                                       )
                                                                     (theory 'minimal-theory)))))

                               ;;this one drops the connection-relation hyp:
                               (defthm ,fns-equal-helper3-theorem-name
                                 (implies (,invariant-name ,@formals-in-invar ,@old-vars-in-invar)
                                          (equal (,fn ,@formals)
                                                 (,new-fn ,@new-formals-in-terms-of-old ,@old-vars-in-explanations)))
                                 :rule-classes nil
                                 :hints (("Goal" :use ((:instance ,fns-equal-helper2-theorem-name)
                                                       (:instance ,fns-equal-helper2b-theorem-name))
                                          :in-theory (theory 'minimal-theory))))

                               ;;this one has the old-vars substituted away:
                               (defthm ,fns-equal-helper4-theorem-name
                                 (implies (,invariant-name ,@formals-in-invar ,@(lookup-eq-lst old-vars-in-invar old-var-to-formal-alist))
                                          (equal (,fn ,@formals)
                                                 (,new-fn ,@new-formals-in-terms-of-old ,@(lookup-eq-lst old-vars-in-explanations old-var-to-formal-alist))))
                                 :rule-classes nil
                                 :hints (("Goal" :use (:instance ,fns-equal-helper3-theorem-name
                                                                 ,@(make-bindings-for-use-hint (union-eq old-vars-in-invar old-vars-in-explanations)
                                                                                               old-var-to-formal-alist))
                                          :in-theory (union-theories '(work-hard) (theory 'minimal-theory)))))

                               ;;this one has the invariant expanded and is the final theorem:
                               (defthm ,fns-equal-theorem-name
                                 ;; don't export it the invariant, now that we are expanding it?
                                 (implies (and ,@(wrap-all 'work-hard (sublis-var-simple-lst old-var-to-formal-alist proved-invars)))
                                          (equal (,fn ,@formals)
                                                 (,new-fn ,@new-formals-in-terms-of-old ,@(lookup-eq-lst old-vars-in-explanations old-var-to-formal-alist))))
                                 :rule-classes nil
                                 :hints (("Goal" :use (:instance ,fns-equal-helper4-theorem-name)
                                          :in-theory (union-theories '(,invariant-name work-hard) (theory 'minimal-theory))))))
                             state))
       ;;ffixme do peeling here?
       (- (cw "done dropping.)~%"))

       )
    (mv nil
        :success
        `(,fns-equal-theorem-name
          ,invariant-name ;we'll need to be able to open this for the rule to fire
;(:definition ,better-invariant-name) ?? improve the invar like we do elsewhere?
          ;;(:definition ,new-base-fn) ;new
          ;;since these may get peeled off and should then be expanded;
          ,@new-update-fns ;(list-onto-all ':definition new-update-fns)
          ,new-exit-fn
          )
        ;;new fns:
        `(,new-fn ,new-exit-fn ;;,new-base-fn
                  ,@new-update-fns)
        new-fn
        (s fn (s :action :dropped-params (empty-map)) analyzed-function-table) ;ensures we don't reanalyze the function (is the dropper lemma likely to fail?)
        state)))


;If this is called, we need to peel off the base case(s) of FN, because there is more than one, or there is one but it is non-trivial.
;Generates a new function (with the peeling off done) and a rule to rewrite fn to the newer function.
;FN should be a defined, tail recursive function (but not necessarily a "nice" tail rec fn)
;The body of FN should be an ITE nest in which every branch is a base case (contains no recursive call) or a recursive call (possibly wrapped in lambdas).
;ffixme can there be more than 1 rec call?
;there may be multiple base cases (as for an unrolled function), in which case, all of the base case logic is moved outside of the new function (including the exit tests, to chose which base case computation to perform), and the exit tests are all combined (ORed?) together inside the function to make a single base case.  the new base case returns a tuple of all the formals that are used in any base case or exit test (and the pulled out logic is fixed up to extract the right values from that return value)
;ffffixme doesn't handle lets yet ... or does it?
  ;; Returns (mv erp result analyzed-function-table state) where result is :error, :failed, or (list new-runes new-fns) - actually no longer returns :error or :failed?
(defun peel-off-base-case-of-tail-fn (fn interpreted-function-alist analyzed-function-table state)
  (declare (xargs :mode :program
                  :stobjs state))
  (let* ( ;;First we combine all the base cases into one:
         (combined-fn (packnew fn '-combined-base-cases))
         (lemma-name (packnew fn '-becomes- combined-fn))
         (state (combine-base-cases-of-tail-fn fn combined-fn lemma-name state))
;now lemma-name connects fn and combined-fn, and combined-fn has just one base case (combined-fn's body must be an if with the base case as arg2)
         (formals (fn-formals fn (w state))) ;same as combined-fn's formals...
         (combined-body (fn-body combined-fn t (w state)))
         (combined-exit-test (farg1 combined-body))
         (combined-base-case (farg2 combined-body))
         (combined-rec-case (farg3 combined-body))

         ;; we need to peel off new-base-case (if there were several base cases that are now combined then new-base-case is an if (and so is not trivial), otherwise since we are calling this function we need to peel -- what if the only thing to be done by this whole function is to make the base-case the thenpart instead of the elsepart?)
         ;;Figure out which formals are mentioned in the base case (fixme should we just use all of them?):
         (formals-to-return-in-peeled-base-case (get-vars-from-term combined-base-case))
         ;;this just puts them in order:
         (formals-to-return-in-peeled-base-case (intersection-eq formals formals-to-return-in-peeled-base-case))

         ;;Make a term that returns all formals used in any base case (as a tuple if there is more than one):
         (just-one-rvp (eql 1 (len formals-to-return-in-peeled-base-case)))
         (new-base-case (if just-one-rvp
                            (car formals-to-return-in-peeled-base-case)
                          (make-cons-nest formals-to-return-in-peeled-base-case)))

         (new-fn (packnew fn '-peeled-off))
         ;; Change the name of the function in the recursive call:
         (new-rec-case (rename-fn combined-fn new-fn combined-rec-case))

         ;; ;; Put in the new base-case term:
         ;; (new-body ;;(fixup-body-for-peeling-off body fn new-fn new-base-case)
         ;;  )

         (theorem-name (packnew fn '-becomes- new-fn))
         (new-fn-call (cons new-fn formals)) ;the new function has the same formals

         ;;fixme could simplify the body by combining exit tests (and maybe opening up the exit tests and simplifying) - done below???

         ;;Since the base case logic must now be applied outside the recursive call,
         ;;we take the base-case fix up references to formals to instead refer to the corresponding component of the function call
         (formal-fn-call-alist
          (if just-one-rvp
              ;;the formal gets replaced by the whole fn-call:
              (acons-fast (first formals-to-return-in-peeled-base-case) new-fn-call nil)
            ;;each formal gets replaced by a component of the fn-call:
            (pairlis$ formals-to-return-in-peeled-base-case
                        (make-nth-terms (len formals-to-return-in-peeled-base-case) new-fn-call))))
         (new-term ;;(fixup-base-cases-and-exit-tests-in-ite body fn formal-fn-call-alist)
          (replace-in-term2 combined-base-case formal-fn-call-alist)) ;fixme use a let?

         (peel-theorem-name (packnew combined-fn '-becomes- new-fn))

         ;;ffixme what about errors?  submit-events-brief will throw one.  hope that's okay!
         (state (submit-events-brief `( ;; the new function:
                                 (skip-proofs ;fixme use the same termination argument as the old function?
                                  (defun ,new-fn ,formals
                                    (declare (xargs :normalize nil)) ;this may be crucial, since we turn off all rules to prove the theorem, we don't want any smarts used to transform the body
;ffixme where else should we use :normalize nil?
;the letify calls are new ;Tue Feb 22 17:47:32 2011
                                    (if ,combined-exit-test ;(letify-term-via-dag combined-exit-test)
                                        ,new-base-case ;(letify-term-via-dag new-base-case)
                                      ,new-rec-case ;(letify-term-via-dag new-rec-case)
                                      )))

                                 (defthm ,peel-theorem-name
                                   (equal (,combined-fn ,@formals)
                                          ,new-term)
                                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                              ;;do we still need this stuff? ffixme
                                                                              '((:executable-counterpart boolor)
                                                                                (:executable-counterpart zp)
                                                                                (:executable-counterpart binary-+)
                                                                                (:REWRITE NTH-OF-CONS)
                                                                                (:definition boolor) ;new
                                                                                ,combined-fn
                                                                                ,new-fn))

                                            :induct (,combined-fn ,@formals))))


                                 ;;replaces the old function call with a term involving the new function call:
                                 (defthm ,theorem-name
                                   (equal (,fn ,@formals)
                                          ,new-term)
                                   :hints (("Goal" :in-theory (theory 'minimal-theory)
                                            :use (,peel-theorem-name ,lemma-name)))))
                               state)))
    (if (not (and (is-a-nice-tail-function new-fn state) ;we know this answer now fffixme
                  (or (call-of 'boolor combined-exit-test)
                      (call-of 'if combined-exit-test))
                  )) ;recognizes unrolled functions.. ffixme do this anytime there is simplification to do?
        (prog2$ (cw "not simplifying exit test.~%")
                (mv nil
                    (list `(,theorem-name)
                          (list new-fn))
                    (s fn (s :action :peel-off-base-case (empty-map)) analyzed-function-table) ;we've handled this function (it should always be replaced by the peeled off version anyway)
                    state))
      ;;Simplify the exit-test if appropriate:
      (let* ((dummy1 (cw "Simplifying exit test..."))
             (exit-test combined-exit-test) ;these are right because it's a nice-tail-rec-fn
             (base-case new-base-case)
             (recursive-case new-rec-case)
             (exit-test-vars (get-vars-from-term exit-test))

             (fns-in-exit-test (get-fns-in-term exit-test))
             (non-built-in-fns-in-exit-test (set-difference-eq fns-in-exit-test *built-in-fns*))
             (defns-for-exit-test non-built-in-fns-in-exit-test ;(cons-onto-all :definition (enlist-all non-built-in-fns-in-exit-test))
               )
             (dummy (cw "simplifying exit test by expanding definitions ~x0~%" defns-for-exit-test))
             (runes-for-exit-test (append defns-for-exit-test
                                          (lookup-rules)
                                          (exit-test-simplification-rules) ;Sun Apr 11 19:11:24 2010
                                          '(boolor-of-sbvlt-combine-gen
                                            boolor-of-sbvlt-combine-gen-alt
                                            boolor-of-sbvlt-combine-gen-better) ;what else?
                                          (amazing-rules-spec-and-dag)
                                          (map-rules)))

             (newer-fn (packnew new-fn '-simplified))) ;fixme would like to drop the -simplified from the name of the resulting function (so that this whole step just adds -peeled-off)
        (declare (ignore dummy1 dummy))
        (mv-let (erp newer-exit-test-dag state)
          ;;can this remove vars?:
          (simp-term exit-test :rules runes-for-exit-test :check-inputs nil)
          (if erp
              (mv erp :error analyzed-function-table state)
            (b* ((newer-fn-exit-test-name (packnew newer-fn '-exit-test))
                 (newer-exit-test-dag-fns (dag-fns newer-exit-test-dag))
                 (newer-exit-test
                  `(dag-val-with-axe-evaluator ',newer-exit-test-dag
                                               ,(make-acons-nest exit-test-vars ;(dag-vars-unsorted newer-exit-test-dag)
                                                                 )
                                               ',(supporting-interpreted-function-alist newer-exit-test-dag-fns interpreted-function-alist t)
                                               0))
                 (newer-fn-exit-tests-theorem-name (packnew new-fn '-and- newer-fn '-exit-tests-equivalent))
                 (newer-fn-theorem-name (packnew new-fn '-and- newer-fn '-equivalent))
                 (replacement-theorem-name (packnew fn '-becomes- newer-fn))
                 (newer-term (rename-fn new-fn newer-fn new-term))
                 ((mv erp letified-base-case) (letify-term-via-dag base-case) ;Tue Feb 22 18:02:32 2011
                  )
                 ((when erp) (mv erp :error analyzed-function-table state))
                 ((mv erp letified-newer-term) (letify-term-via-dag newer-term)) ;Tue Feb 22 22:23:09 2011
                 ((when erp) (mv erp :error analyzed-function-table state))
                 (state (submit-events-brief `((defun ,newer-fn-exit-test-name ,exit-test-vars
                                           (declare (xargs :normalize nil))
                                           ,newer-exit-test)

                                         (skip-proofs
                                          (defun ,newer-fn ,formals
                                            (declare (xargs :normalize nil))
                                            (if (,newer-fn-exit-test-name ,@exit-test-vars) ;only this is different from new-fn
                                                ,letified-base-case
                                              ,(rename-fn new-fn newer-fn recursive-case) ;(letify-term-via-dag (rename-fn new-fn newer-fn recursive-case))
                                              )))

                                         (defthm ,newer-fn-exit-tests-theorem-name
                                           (iff (,newer-fn-exit-test-name ,@exit-test-vars)
                                                ,exit-test)
                                           :hints (("Goal" :in-theory (union-theories '(,newer-fn-exit-test-name) (theory 'minimal-theory)))
                                                   (if STABLE-UNDER-SIMPLIFICATIONP
                                                       '(:clause-processor
                                                         (axe-prover ;fixme what bout unroll?
                                                          clause
                                                          ',(s :goal-name newer-fn-exit-tests-theorem-name
                                                               (axe-prover-hints
                                                                runes-for-exit-test ;ffixme add other stuff now that we are not using built ins?
                                                                (empty-rule-alist)
                                                                interpreted-function-alist
                                                                analyzed-function-table
                                                                ))
                                                          state)
                                                         :do-not '(generalize eliminate-destructors))
                                                     nil)))

                                         (defthm ,newer-fn-theorem-name
                                           (equal (,new-fn ,@formals)
                                                  (,newer-fn ,@formals))
                                           :hints (("Goal" :in-theory (union-theories '(,new-fn ,newer-fn ,newer-fn-exit-tests-theorem-name)
                                                                                      (theory 'minimal-theory)))))


                                         (defthm ,replacement-theorem-name
                                           (equal (,fn ,@formals)
                                                  ,letified-newer-term)
                                                  :hints (("Goal" :in-theory (theory 'minimal-theory)
                                                           :use ((:instance ,newer-fn-theorem-name)
                                                                 (:instance ,theorem-name))))))
                                         state)))
              (mv nil
                  (list `(,replacement-theorem-name
                          ,newer-fn-exit-test-name ;bad things happened when this was missing (investigate?!)
;ffixme why not (:definition ,newer-fn) ??
                          )
                        (list newer-fn
                              newer-fn-exit-test-name))
                  (s fn (s :action :peel-off-base-case (empty-map)) analyzed-function-table) ;we've handled this function (it should always be replaced by the peeled off version anyway)
                  state))))))))


;;used for improving an invariant
;;returns (mv erp result defthm-name state), where if RESULT is non-nil, then it is a simplified term equal to FACT (assuming FACTS-TO-ASSUME), and DEFTHM-NAME is the name of the theorem that proves the equivalence
;fixme pass in rule classes?
(defun simplify-fact (fact            ;a term
                      facts-to-assume ;also terms
                      rule-alist
                      defthm-name print state)
  (declare (xargs :mode :program :stobjs state))
  (mv-let (erp simplified-fact state)
    ;;should this call the new rewriter with a rewrite objective?  maybe not, since we also want to rewrite things to t (that might still happen even with an objective of nil)...
    (simp-term fact
               :rule-alist rule-alist
               :print print
               :assumptions facts-to-assume
               :normalize-xors nil
               :check-inputs nil)
    (if erp
        (mv erp nil nil state)
      (let ((simplified-fact (dag2term simplified-fact))) ; i hope this never blows up
        (if (equal fact simplified-fact)
            ;;no change:
            (mv nil nil nil state)
          ;;now we just put in a skip-proofs and so trust that the
          ;;simplification works (seems no less safe than trusting the
          ;;prover...)
          (let* ((state (submit-event-brief `(skip-proofs
                                        (defthm ,defthm-name
                                          (implies (and ,@facts-to-assume)
                                                   (equal ,fact
                                                          ,simplified-fact))
                                          ;; :hints (("goal" :in-theory (theory 'minimal-theory)
                                          ;;          :do-not '(generalize eliminate-destructors))
                                          ;;         (if stable-under-simplificationp
                                          ;;             '(:clause-processor
                                          ;;               (axe-prover
                                          ;;                clause
                                          ;;                ',(s :goal-name defthm-name
                                          ;;                     (axe-prover-hints
                                          ;;                      ;;these we want for the prover but not when rewriting the facts above?:
                                          ;;                      '(EQUAL-OF-T-WHEN-BOOLEANP-ARG2
                                          ;;                        EQUAL-OF-T-WHEN-BOOLEANP-ARG1)
                                          ;;                      (make-rule-alist-simple ...rules t (table-alist 'axe-rule-priorities-table (w state)))
                                          ;;                      nil ;interpreted-function-alist
                                          ;;                      nil ;test cases
                                          ;;                      (empty-analyzed-function-table) ;fffixme
                                          ;;                      ))
                                          ;;                state)
                                          ;;               :do-not '(generalize eliminate-destructors))
                                          ;;           nil))
                                          ))
                                      state)))
            (mv nil simplified-fact defthm-name state)))))))

;; Tries to find a member of INVARS-TO-IMPROVE which can be rewritten assuming ALL-INVARS-TO-IMPROVE and UNCHANGED-VAR-INVARS
;; Returns (mv erp old-invar-or-nil new-invar defthm-name state) where if OLD-INVAR-OR-NIL is nil, no invar was found to improve (and new-invar and defthm-name are meaningless).  Otherwise, old-invar is equivalent to new-invar, given the other invars (not including old-invar), and defthm-name captures that fact.
;fixme print less?
(defun find-an-invar-to-improve (invars-to-improve all-invars-to-improve unchanged-component-invars rule-alist defthm-base-name defthm-count print ;invariant-name invariant-formals
                                                   state)
  (declare (xargs :mode :program :stobjs state))
  (if (endp invars-to-improve)
      ;;failed to find an invar to improve:
      (mv nil nil nil nil state)
    (let* ((old-invar (first invars-to-improve)))
      (progn$ (cw "(Trying to improve invar (print ~x1):~%~x0~%" old-invar print)
              (mv-let (erp new-invar defthm-name state)
                (simplify-fact old-invar
                               (append (remove-equal old-invar all-invars-to-improve) unchanged-component-invars)
                               rule-alist
                               (packnew defthm-base-name defthm-count '-helper) ;this one gets the name ...-helper
                               print
                               state)
                (if erp
                    (mv erp nil nil nil state)
                  (if new-invar
                      (progn$  (cw "Improved invar:~%~x0~%)~%" new-invar)
                               (mv nil old-invar new-invar defthm-name state))
                    (progn$
                     (cw "No change.)~%")
                     (find-an-invar-to-improve (rest invars-to-improve) all-invars-to-improve unchanged-component-invars rule-alist
                                               defthm-base-name defthm-count print state)))))))))

;; maintains a set of conjuncts that, when conjoined to unchanged-component-invars, is always equivalent to the call of the invariant
;; generates a sequence of theorems proving that each successive set of invars is equivalent to the call of the original invariant
;; repeatedly finds an invar that can be improved using other invars and replaces it with its new version
;; Returns (mv erp improved-invars last-defthm-name state)
;fixme print less?
(defun improve-invars-aux (current-invar-set unchanged-component-invars rule-alist
                                             defthm-base-name
                                             previous-defthm-name
                                             defthm-count
                                             print invariant-name invariant-formals state)
  (declare (xargs :mode :program :stobjs state))
  (mv-let (erp old-invar new-invar defthm-name state)
    (find-an-invar-to-improve current-invar-set current-invar-set unchanged-component-invars rule-alist defthm-base-name defthm-count print ;invariant-name invariant-formals
                              state)
    (if erp
        (mv erp nil nil state)
      (if (not old-invar)
          ;;can't improve any more invars:
          (mv nil
              (append current-invar-set unchanged-component-invars)
              previous-defthm-name
              state)
        (let* ((invar-set-without-the-improved-invar (remove-equal old-invar current-invar-set))
               (new-invar-set (if (equal *t* new-invar) ;fixme what about constants other than t?
                                  ;; the invar was improved to "true" so drop it:
                                  invar-set-without-the-improved-invar
                                ;;we improved an invar, so replace the old version:
                                (cons new-invar invar-set-without-the-improved-invar)))
               (new-defthm-name (packnew defthm-base-name defthm-count))
               ;;prove that the invariant call is equivalent to the new invariant set:
               (state (submit-event-brief `(defthm ,new-defthm-name
                                       (iff (,invariant-name ,@invariant-formals)
                                            (and ,@new-invar-set
                                                 ,@unchanged-component-invars))
                                       :rule-classes nil ;Mon Jan 24 10:03:29 2011
                                       :hints (("Goal" :use ((:instance ,defthm-name)
                                                             (:instance ,previous-defthm-name) ;says that the invariant call is equal to current-invar-set
                                                             )
                                                :in-theory (theory 'minimal-theory))))
                                    state)))
          (improve-invars-aux new-invar-set
                              unchanged-component-invars rule-alist
                              defthm-base-name
                              new-defthm-name
                              (+ 1 defthm-count) print invariant-name invariant-formals state))))))

;fixme could we ever want to improve an unchanged invar?  x=oldx could become x=0.
;; requires that applying invariant-name to invariant-formals is equivalent to the conjunction of regular-invars and unchanged-component-invars
;; Returns (mv erp improved-invars defthm-name state) where the conjunction of improved-invars is equal to the call of the original invariant, and the defthm proves that fact
(defun improve-invars (regular-invars
                       unchanged-component-invars ;really these don't have to be about unchanged vars?  they are just not simplified like the other invars
                       print invariant-name invariant-formals state)
  (declare (xargs :mode :program :stobjs state))
  (prog2$ (cw "(Improving invars:~%")
          (let* ((defthm-base-name (packnew invariant-name '-improvement-lemma-))
                 (first-defthm-name (packnew defthm-base-name 0))
                 ;; the first theorem just says that the call of the invariant is equal to its body (trivial)
                 (state (submit-event-brief `(defthm ,first-defthm-name
                                         ;;iff seemed necessary here (not sure why equal didn't work)
                                         (iff (,invariant-name ,@invariant-formals)
                                              (and ,@regular-invars
                                                   ,@unchanged-component-invars))
                                         :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                    '(,invariant-name)))))
                                      state)))
            (mv-let (erp improved-invars last-defthm-name state)
              (improve-invars-aux regular-invars
                                  unchanged-component-invars
                                  ;;ffixme more rules?
                                  ;; todo: use plain make-rule-alist here:
                                  (make-rule-alist! (append (exit-test-simplification-rules)
                                                           (booleanp-rules) ;did not want turn-equal-around..
                                                           '(sbvlt-of-minus-one
                                                             EQUAL-OF-CONSTANT-AND-SLICE-WHEN-BVLT ;new
                                                             BVLT-TRANSITIVE-1-A
                                                             BVLT-TRANSITIVE-1-B
                                                             BVLT-TRANSITIVE-2-A
                                                             BVLT-TRANSITIVE-2-B
                                                             ) ;new
                                                           (boolean-rules))
                                                   (w state))
                                  defthm-base-name
                                  first-defthm-name
                                  1 print invariant-name invariant-formals state)
              (if erp
                  (mv erp nil nil state)
                (progn$ (cw "(New invars: ~x0)" improved-invars)
                        (cw "Done improving invars.)~%")
                        (mv nil improved-invars last-defthm-name state)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;returns (mv lst rand)
(defun merge-rand (l1 l2 acc rand)
  (declare (xargs :measure (+ (len l1) (len l2))
                  :guard (and
                              (true-listp acc))
                  :stobjs rand))
  (cond ((atom l1) (mv (revappend acc l2) rand)) ; todo: would null be faster than atom?
        ((atom l2) (mv (revappend acc l1) rand))
        (t (mv-let (val rand)
                   (genrandom 2 rand)
                   (if (eql 0 val)
                       (merge-rand (cdr l1) l2 (cons (car l1) acc) rand)
                     (merge-rand l1 (cdr l2) (cons (car l2) acc) rand))))))

;returns (mv lst rand)
;probably not truly random, but seems good enough..
(defun shuffle-list (l rand)
  (declare (xargs :guard (true-listp l)
                  :stobjs rand
                  :measure (len l)))
  (if (atom (cdr l))
      (mv l rand)
    (mv-let (first-half second-half)
      (split-list-fast l)
      (mv-let (first-half rand)
        (shuffle-list first-half rand)
        (mv-let (second-half rand)
          (shuffle-list second-half rand)
          (merge-rand first-half
                      second-half
                      nil
                      rand))))))

;takes an nth nest around a formal
(defun get-formal-and-path (item path-acc)
  (if (atom item)
      (cons item path-acc)
    (if (not (and (call-of 'nth item)
                  (quotep (farg1 item))))
        (hard-error 'get-formal-and-path "unrecognized thing: ~x0." (acons #\0 item nil))
    (get-formal-and-path (farg2 item) (cons (unquote (farg1 item)) path-acc)))))

(defun print-component (path item)
  (if (endp path)
      (cw "~x0 " item)
    (print-component (rest path) (nth (first path) item))))

(defun print-components-of-trace (path trace)
  (if (endp trace)
      nil
    (prog2$ (print-component path (first trace))
            (print-components-of-trace path (rest trace)))))

(defun print-components-of-traces (path traces)
  (if (endp traces)
      nil
    (progn$ (cw "(")
            (print-components-of-trace path (first traces))
             (cw ")~%")
            (print-components-of-traces path (rest traces)))))

(defun print-traces (items formal-traces-alist)
  (if (endp items)
      nil
    (let* ((item (first items))
           (formal-and-path (get-formal-and-path item nil))
           (formal (car formal-and-path))
           (path (cdr formal-and-path))
           (formal-traces (lookup-eq formal formal-traces-alist)))
           (progn$
            (cw "(Traces for ~x0:~%" item)
            (print-components-of-traces path formal-traces)
            (cw ")")
            ))))

(defun consp-with-rationalp-car (x)
  (declare (xargs :guard t))
  (and (consp x)
       (rationalp (car x))))

(defun car-< (x y)
  (declare (xargs :guard (and (consp-with-rationalp-car x)
                              (consp-with-rationalp-car y))))
  (< (car x) (car y)))

;merge-car-< and merge-sort-car-< are newly defined in ACL2 5.0? just use them?
(defmergesort merge-sort-car-<-2 merge-car-<-2 car-< consp-with-rationalp-car)

(defun make-sorted-pair (fn1 fn2)
  (declare (type symbol fn1 fn2))
  (if (symbol< fn1 fn2)
      (cons fn1 fn2)
    (cons fn2 fn1)))

;recently removed this from the main mutual recursion:
;returns (mv erp new-runes unchanged-runes new-fns analyzed-function-table rand state)
;before this function is called, any non-trivial base-case (anything other than a single param or a tuple of params) should have been peeled off, and any redundant params should have been dropped.
;this now filters out some of the invars at the end (but we seem to need them to prove the inductive theorem) - still true?
;ffffixme adapted this to be more general (more than 1 param, update and exit that aren't just function calls) - could this still use functional instantiation
;this adds :updates-preserve-invariant-theorem-name and :invariant-name to the analyzed-function-table - do we actually use this? yes!  when connecting this fn to another
(defun prove-theorems-about-tail-function (fn
                                           proved-invars ;the proved invariant conjuncts (over the formals and old-vars)
                                           update-preserves-invars-rule-symbols
                                           proved-unchanged-component-invars ;a subset of proved-invars
                                           old-vars ;in sync with the formals
                                           old-var-to-formal-alist ; these are harvested from the hyps (not any more?) ;an old var is now for an entire formal, not a component...
                                           probably-unchanged-components ;each is a nest of nths (and maybe a len??) around a formal ;we may fail to prove some of these, and that's okay - can these have more than 1 nth? ;fixme now passed in only so we can store them with the info about the function
                                           explanation-graph ;passed in only so that we can store it
                                           exit-test-expr
                                           base-case-expr
                                           update-expr-list ;one for each formal
                                           oldval-replacement-alist
                                           formal-shape-alist
;rewriter-rule-alist
                                           prover-rule-alist extra-stuff interpreted-function-alist
                                           args-traces
;unroll
;miter-depth-to-use ;the depth to use if this routine needs to build a miter
                                           analyzed-function-table
;monitored-symbols
                                           max-conflicts print
                                           rand state)
  (declare (xargs :mode :program :stobjs (rand state)))
  (b* ((- (cw "(Will prove theorems about the return values of nice tail recursive function ~x0.)~%" fn))
       (formals (fn-formals fn (w state))) ;pass in!
       (fn-call `(,fn ,@formals))
       ;; pairs each formal with the expression that updates it (in terms of some or all of the formals)
       (formal-update-expr-alist (pairlis$ formals update-expr-list)) ;pass in!
       (negated-exit-test `(not ,exit-test-expr)) ;pass in!

       ;; the invariant will be over the formals and maybe some old-vars; should hold each time the formals get updated
       (invariant-name (packnew fn '-invariant))
       ;;the rv-predicate will be over the return value, rv, and maybe some old-vars (note: return value may not include all formals)
       (rv-predicate-name (packnew fn '-rv-predicate)) ;ffixme don't include irrelevant old vars..
       (updates-preserve-invariant-theorem-name (packnew fn '-updates-preserve-invar))
;        (invar-implies-rv-predicate-of-base-case-expr-theorem-name (packnew fn '-invar-implies-rv-predicate-of-base-case))
       (fn-obeys-rv-predicate-theorem-name (packnew fn '-obeys-rv-predicate))
       (fn-obeys-rv-predicate-theorem-name-no-old-vars (packnew fn '-obeys-rv-predicate-no-aux))
       (fn-obeys-rv-predicates-helper-theorem-name (packnew fn '-obeys-rv-predicates-helper))
       (fn-obeys-rv-predicates-theorem-name (packnew fn '-obeys-rv-predicates))
       (- (cw "(Maximal set of proved invars (len ~x0): ~x1)~%" (len proved-invars) proved-invars)) ;print above?
       ;;these depend on which invars are actually inductive:
       (vars-mentioned-in-proved-invars (get-vars-from-terms proved-invars))
       (old-vars-in-invariant (intersection-eq old-vars vars-mentioned-in-proved-invars))
       (formals-in-invariant (intersection-eq formals vars-mentioned-in-proved-invars))

       ;;the invariant now includes the unchangedness facts
       (invariant-formals (append formals-in-invariant old-vars-in-invariant))
       (invariant-call-on-formals-and-old-vars `(,invariant-name ,@invariant-formals))

       ;;fixme pull this stuff out into the parent?
       (state
        (submit-events-brief `((defun ,invariant-name ,invariant-formals
                           (declare (xargs :normalize nil)) ;may be crucial (fffixme where else might i want this?)
                           (and ,@proved-invars))

                         ;; Prove that the updates preserve the whole invariant (easy since we know they preserve each conjunct):
                         (defthm ,updates-preserve-invariant-theorem-name
                           (implies (and ,negated-exit-test
                                         ,invariant-call-on-formals-and-old-vars)
                                    (,invariant-name ,@(lookup-eq-lst formals-in-invariant formal-update-expr-alist)
                                                     ,@old-vars-in-invariant))
                           :rule-classes nil
                           :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                      '(,invariant-name))
                                    :do-not '(generalize eliminate-destructors)
                                    :use (,@update-preserves-invars-rule-symbols)))))
                       state))
       (proved-regular-invars (set-difference-equal proved-invars proved-unchanged-component-invars)) ;the removal here is new Thu Feb 17 01:03:27 2011
       ;; Now improve the invariant by simplifying each conjunct assuming the others (drops *t*s): fixme do we still need to do this? i guess it gets rid of some redundant stuff
       ;; This uses the unchangedness facts to push back the invars to be about the old vars when possible.  good because when the unchangedness facts are later applied they will replace (nth 0 (foo x)) with (nth 0 x) so the invars should also be about (nth 2 x).  imagine foo has two rvs, and we have as an invr some predicate over them.  then we could prove (pred (nth 0 (foo x y)) (nth 1 (foo x y)).  but if nth 0 is unchanged, (nth 0 (foo x y)) will become just x, so that's what we prefer to have the invariant mention. subtle.
;do we want to do this for dropping too?
       ((mv erp
            better-proved-invars ;fixme can the formals mentioned in these ever change?  i think not.
            better-proved-invar-defthm-name ;proves that the call of the invariant is equal to the conjunction of better-proved-invars
            state)
        (improve-invars proved-regular-invars proved-unchanged-component-invars print invariant-name invariant-formals state))
       ((when erp) (mv erp nil nil nil analyzed-function-table rand state))
       (better-invariant-name (packnew 'better- invariant-name))
       (updates-preserve-better-invariant-theorem-name (packnew fn '-updates-preserve-better-invar))
       (better-invariant-theorem-name (packnew invariant-name '-implies- better-invariant-name))
       (better-invariant-formals invariant-formals) ;ffixme i hope the formals are the same for the better- invariant..
       (better-invariant-call `(,better-invariant-name ,@better-invariant-formals)) ;fixme use more
       (state
        (submit-events-brief `((defun ,better-invariant-name ,better-invariant-formals
                           (declare (xargs :normalize nil)) ;may be crucial? (fffixme where else might i want this?)
                           (and ,@better-proved-invars))

                         ;; The better invariant is equivalent to the original one: ;fixme compare to better-proved-invar-defthm-name..
                         (defthm ,better-invariant-theorem-name
                           (iff (,better-invariant-name ,@better-invariant-formals)
                                (,invariant-name ,@invariant-formals))
                           ;;:rule-classes nil ;used just below as a rewrite rule
                           :hints (("goal" :in-theory (union-theories (theory 'minimal-theory) '(,better-invariant-name))
                                    :do-not '(generalize eliminate-destructors)
                                    :use (,better-proved-invar-defthm-name))))

                         ;;this is what we'll use in a proof connecting this fn and another function:
                         (defthm ,updates-preserve-better-invariant-theorem-name
                           (implies (and ,negated-exit-test
                                         (,better-invariant-name ,@better-invariant-formals)) ;fixme are these formals always right?:
                                    (,better-invariant-name ,@(lookup-eq-lst formals-in-invariant formal-update-expr-alist)
                                                            ,@old-vars-in-invariant))
                           :rule-classes nil
                           :hints (("goal" :in-theory (union-theories
                                                       '(,better-invariant-theorem-name) ;or we could :use two instances of this
                                                       (theory 'minimal-theory))
                                    :do-not '(generalize eliminate-destructors)
                                    :use (,updates-preserve-invariant-theorem-name)))))
                       state))

       ;; now we try to strengthen the better-proved-invars using the exit test.
       ;; example: if the invariant says that i<=j but the exit test is j<=i, we know upon exit
       ;; that i=j, which is stronger than i<=j.

       ;;first, if the exit test is just a call of a user function on the formals, expand it:
       ;;ffixme what if it's some more complicated expression involving user functions (e.g., a disjunction, as when unrolling)?
       ;;would have to do something fancier to expand and simplify (disjunctions from unrolling are now handled through combining (e.g., boolor of x<2 and x<3)?)
       ;;fffixme this "simplify and prove" pattern could be replaced by simplify fact?
       (exit-test-is-a-simple-callp (call-of-user-fn-on-formalsp exit-test-expr formals))
       ;;this is over the formals (can be a call to dag-val.. ?)
       (expanded-exit-test-expr (if (not exit-test-is-a-simple-callp)
                                    (prog2$ (cw "(Nothing to expand for the exit test.)~%")
                                            exit-test-expr)
                                  (prog2$ (cw "(Expanding the exit test.)~%")
                                          (expand-fn-call-expr exit-test-expr state))))

       (expanded-exit-test-theorem-name (packnew fn '-expanded-exit-test-theorem))
       (state
        ;;this is trival if exit-test-is-a-simple-callp is nil.  otherwise it follows from the expansion of the function (ffixme is :normalize an issue?):
        (submit-event-brief `(defthm ,expanded-exit-test-theorem-name
                         (iff ,exit-test-expr
                              ,expanded-exit-test-expr)
                         :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                    '(,(ffn-symb exit-test-expr) ;ffixme what does this do if we are not expanding?
                                                                      ))
                                  :do-not '(generalize eliminate-destructors)))
                         :rule-classes nil)
                      state))
       ;; we simplify the exit-test-expr, assuming the (better) invariants:
       ;;why do we do this? i think it's to turn things like sbvlt into nicer things like bvlt
       ;;if we change the opening of the exit test above, could combine it with this?
       ((mv erp simplified-expanded-exit-test-expr state)
        (progn$ (cw "(Simplifying expanded exit test using assumptions:~%")
                (print-list better-proved-invars)
                (simp-term expanded-exit-test-expr
                           :rules
                           ;;ffixme more rules!
                           (exit-test-simplification-rules) ;todo: pre-compute the rule-alist?
                           :print t
                           :interpreted-function-alist interpreted-function-alist
                           :monitor ;ffixme what else? or drop these?
                           '(sbvlt-of-bvplus-of-constant
                             ;;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger
                             ;;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger-alt
                             )
                           :assumptions better-proved-invars ;use the original invars?? maybe not, since this will push back the exit test if it mentions an unchanged var
                           :normalize-xors nil
                           :check-inputs nil)))
       ((when erp) (mv erp nil nil nil analyzed-function-table rand state))
       (simplified-expanded-exit-test-expr (dag2term simplified-expanded-exit-test-expr))
       (- (cw "Simplified exit test: ~x0)~%" simplified-expanded-exit-test-expr))
       (simplified-expanded-exit-test-theorem-name (packnew fn '-simplified-expanded-exit-test-theorem))
       ;;make sure to include here anything we used above to simplify the exit test (fffixme do the simplification and the proof simultaneously?):
       (state
        (submit-event-brief `(defthm ,simplified-expanded-exit-test-theorem-name
                         (implies (,better-invariant-name ,@better-invariant-formals)
                                  (iff ,expanded-exit-test-expr
                                       ,simplified-expanded-exit-test-expr))
                         :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                    '(,(ffn-symb exit-test-expr)
                                                                      ,better-invariant-name))
                                  :do-not '(generalize eliminate-destructors))
                                 (if stable-under-simplificationp
                                     '(:clause-processor
                                       (axe-prover
                                        clause
                                        ',(s :goal-name simplified-expanded-exit-test-theorem-name
                                             (axe-prover-hints
                                              (exit-test-simplification-proof-rules)
                                              ;;ffixme this causes a lot of printing!!
                                              prover-rule-alist ;do we want all of these?
                                              nil ;interpreted-function-alist
                                              (empty-analyzed-function-table) ;fffixme
                                              ))
                                        state)
                                       :do-not '(generalize eliminate-destructors))
                                   nil))
                         :rule-classes nil)
                      state))

       ;; Now build the claims about the function's return value.
       (user-supplied-final-claims (g :extra-rv-claims (g fn extra-stuff)))
       (- (and user-supplied-final-claims (cw "user-supplied RV claims (will have any oldval calls replaced): ~x0.~%" user-supplied-final-claims)))
       (- (syntax-okay-for-annotationsp fn user-supplied-final-claims :extra-rv-claims formals))
       (user-supplied-final-claims (replace-in-terms2 user-supplied-final-claims oldval-replacement-alist))
;fixme could we use test-cases-for-formals-and-old-vars for this?
       (- (if (rv-claims-work-on-tracesp user-supplied-final-claims args-traces formals interpreted-function-alist old-var-to-formal-alist)
              t
            (hard-error 'prove-theorems-about-tail-function "A User-supplied RV claim failed to hold on all traces. See above." nil)))

       (- (cw "(Trying to find final claims for ~x0:~%" fn))
       (arity (len formals))
       (last-tuples (map-last-elem args-traces)) ;one tuple per trace
       (formals-last-vals-lst (get-nths-from-values arity last-tuples)) ;in sync with the formals: each entry is for one formal and gives the last val of that formal on each trace
       (first-tuples (strip-cars args-traces)) ;one tuple per trace
       (formals-old-vals-lst (get-nths-from-values arity first-tuples)) ;in sync with the formals: each entry is for one formal and gives the "old" val of that formal on each trace

       ;;this can now find more than one explanation for the same RV (in case some don't prove):
;fixme don't bother with any values that are not returned? or that aren't referenced by the parent of this rec fn in the overarching DAG?
       (discovered-final-claims (try-to-express-last-value-of-target-tree-list-with-any-candidate
                                 formals
                                 formals-last-vals-lst
                                 ;;old-candidate-value-alist ;pairs the old expression for each candidate with its vals (one per trace):
                                 (pairlis$ old-vars ;in sync with the formals
                                             formals-old-vals-lst)
                                 nil))
       (all-final-claims (append user-supplied-final-claims discovered-final-claims))
;will the really be dupes? what about equalities both ways?
       (new-final-claims (remove-duplicates-equal (set-difference-equal all-final-claims better-proved-invars)))
       (- (cw "New final claims for ~x0:~%~x1)~%" fn new-final-claims))
       ;; Attempt to prove the final claims using the exit test
       ((mv erp proved-new-final-claims final-claims-defthm-names state)
        (prove-final-claims new-final-claims
                            (list simplified-expanded-exit-test-expr `(,better-invariant-name ,@better-invariant-formals))
                            (pack$ fn '-final-claim-) max-conflicts prover-rule-alist
                            `(,better-invariant-name) ;because this will need to be opened
                            interpreted-function-alist state))
       ((when erp) (mv erp nil nil nil analyzed-function-table rand state))
;(proved-final-claims (append proved-new-final-claims better-proved-invars)) ;everything true on the final iteration
       (proved-final-claim-name (packnew fn '-final-claim))
       (proved-final-claim-formals (intersection-eq (append formals old-vars) (get-vars-from-terms proved-new-final-claims)))
       (proved-final-claim-lemma-name (packnew proved-final-claim-name '-lemma))
       (proved-final-claim-lemma-name-helper1 (packnew proved-final-claim-lemma-name '-helper1))
       (proved-final-claim-lemma-name-helper2 (packnew proved-final-claim-lemma-name '-helper2))
       (state
        (submit-events-brief `((defun ,proved-final-claim-name (,@proved-final-claim-formals) ;ffixme do we need both this and the rv predicate?  well, the rv predicate is over rv, not the formals...
                           (declare (xargs :normalize nil))
                           (and ,@proved-new-final-claims ;proved-final-claims
                                ))

                         ;;prove the strengthening (using the theorems generated when strengthening)
                         (defthm ,proved-final-claim-lemma-name-helper1
                           (implies (and ,simplified-expanded-exit-test-expr
                                         (,better-invariant-name ,@better-invariant-formals))
                                    (,proved-final-claim-name ,@proved-final-claim-formals))
                           :rule-classes nil
                           :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                      '(,better-invariant-name
                                                                        ,proved-final-claim-name))
                                    :use (,@final-claims-defthm-names)
                                    :do-not '(generalize eliminate-destructors))))

                         ;;pushes back the hyp:
                         (defthm ,proved-final-claim-lemma-name-helper2
                           (implies (and ,expanded-exit-test-expr
                                         (,better-invariant-name ,@better-invariant-formals))
                                    (,proved-final-claim-name ,@proved-final-claim-formals))
                           :rule-classes nil
                           :hints (("goal" :in-theory (theory 'minimal-theory)
                                    :use (,proved-final-claim-lemma-name-helper1
                                          ,simplified-expanded-exit-test-theorem-name)
                                    :do-not '(generalize eliminate-destructors))))

                         ;;push back the hyp again:
                         (defthm ,proved-final-claim-lemma-name
                           (implies (and ,exit-test-expr ;or do we want this open?
                                         (,better-invariant-name ,@better-invariant-formals))
                                    (,proved-final-claim-name ,@proved-final-claim-formals))
                           :rule-classes nil
                           :hints (("goal" :in-theory (theory 'minimal-theory)
                                    :use (,proved-final-claim-lemma-name-helper2
                                          ,expanded-exit-test-theorem-name)
                                    :do-not '(generalize eliminate-destructors)))))
                       state))
       ;; Build the rv predicate (not all formals may be returned):
       (single-param-base-casep (symbolp base-case-expr))
       (formals-mentioned-in-base-case (if single-param-base-casep
                                           (list base-case-expr)
                                         (get-consed-items-from-cons-nest base-case-expr)))
       (- (cw "(Formals mentioned in base case: ~x0)~%" formals-mentioned-in-base-case))

       ;;pairs each formal that is returned with its expression in terms of 'rv:
       (formal-rv-component-alist (if single-param-base-casep
                                      (acons-fast base-case-expr 'rv nil)
                                    (pairlis$ formals-mentioned-in-base-case
                                                (make-nth-terms (len formals-mentioned-in-base-case) 'rv))))

       ;;             ;;pairs each formal that is returned with its component of the fn-call:
       ;;             (formal-fn-call-component-alist (if single-param-base-casep
       ;;                                                 (acons base-case-expr fn-call nil)
       ;;                                               (pairlis$ formals-mentioned-in-base-case
       ;;                                                           (make-nth-terms
       ;;                                                            (len formals-mentioned-in-base-case)
       ;;                                                            fn-call))))


       ;;              (len-of-base-case-tuple (if single-param-base-casep
       ;;                                          :not-a-tuple
       ;;                                        (len formals-mentioned-in-base-case)))

       ;; Drop invars about any params that aren't returned in the base case.
       ;; These are over the formals and old-vars:
       ;;fixme this should include the exit test too?
       (claims-for-rv-predicate
        (keep-terms-that-mention-only (append formals-mentioned-in-base-case
                                              old-vars ;okay to mention these, since we'll substitute in for them
                                              )
                                      (append proved-new-final-claims better-proved-invars) ;proved-final-claims
                                      ))
       ;;we remove any invars that are only about old vars:
       (claims-to-remove-from-rv-predicate (keep-terms-that-mention-only old-vars claims-for-rv-predicate))
       (- (cw "(Removing invars from rv pred (they mention only old vars): ~x0)~%" claims-to-remove-from-rv-predicate))
       (claims-for-rv-predicate (set-difference-equal claims-for-rv-predicate claims-to-remove-from-rv-predicate))
       (- (cw "(Final list of rv claims:~%~x0)~%" claims-for-rv-predicate))
       )
    (if (not claims-for-rv-predicate)
        (prog2$ (cw "!! FAILED to prove any invariants about the RVs of ~x0" fn) ;fixme perhaps throw a hard error?  shouldn't we always at least have a type theorem?
                (mv nil                   ;no error
                    `(,invariant-name     ;drop?
                      ,better-invariant-name)
                    nil                       ;unchanged runes
                    (list invariant-name)     ;needed?
                    (prog2$ (cw "(Storing info for ~x0.)~%" ;(keep-entries old-vars-in-invariant old-var-to-formal-alist)
                                fn)
                            ;;fffixme think about what stuff to store in this case: store an :action?!
                            (let ((analyzed-function-table ;;these are still okay to use, I guess:
                                   (s fn (s :unchanged-components probably-unchanged-components ;fixme omit any that failed to prove?
                                            (s :invariant-name better-invariant-name
                                               (s :updates-preserve-invariant-theorem-name updates-preserve-better-invariant-theorem-name
                                                  (s :explanation-graph explanation-graph
                                                     (g fn analyzed-function-table))))) ;maybe fn never has an entry already?
                                      analyzed-function-table)))
                              ;;do we use this? yes, when proving the connection lemma ;fffixme think about what to do in this case?
                              ;;ffixme think about this?

                              (s fn
                                 (s :old-var-to-formal-alist
                                    (keep-entries old-vars-in-invariant old-var-to-formal-alist) ;keep only the info about old-vars that appear in the invariant because that is what's used
                                    (g fn analyzed-function-table))
                                 analyzed-function-table)))
                    rand state))
      (let* ( ;;these are over 'rv and the old-vars:
             (conjuncts-for-rv-predicate (sublis-var-simple-lst formal-rv-component-alist claims-for-rv-predicate))
             (all-vars-mentioned-in-rv-predicate (get-vars-from-terms conjuncts-for-rv-predicate))
             (rv-predicate-formals ;guaranteed not to be empty?
              ;; order matters?:
              (intersection-eq (cons 'rv old-vars) all-vars-mentioned-in-rv-predicate))

             (proved-final-claim-implies-rv-predicate-theorem-name (packnew proved-final-claim-name '-implies- rv-predicate-name))
             (exit-test-and-better-invar-imply-rv-predicate-theorem-name (packnew invariant-name '-and-exit-test-imply- rv-predicate-name))

             ;; ffixme make a separate function?:
             (better-invariant-call-no-old-vars (sublis-var-simple old-var-to-formal-alist better-invariant-call))

             ;;replace 'rv with the function call, and replace old vars with their corresponding formals:
             ;;these are over the fn-call and formals
             (conjuncts-for-rv-predicate-instantiated (sublis-var-simple-lst
                                                       (acons-fast 'rv
                                                                   fn-call
                                                                   old-var-to-formal-alist)
                                                       conjuncts-for-rv-predicate))

             ;; Define the predicate on return values:
             (state (submit-events-brief
                     `( ;; This is over 'rv and some of the old vars:
                       (defun ,rv-predicate-name ,rv-predicate-formals
                         (declare (xargs :normalize nil))
                         (and ,@conjuncts-for-rv-predicate))

                       ;; proves that the final claim implies the rv pred of the base case (easy)
                       (defthm ,proved-final-claim-implies-rv-predicate-theorem-name ;fixme rename!
                         (implies (and (,proved-final-claim-name ,@proved-final-claim-formals)
                                       (,better-invariant-name ,@better-invariant-formals))
                                  (,rv-predicate-name ,@(sublis-var-simple-lst (acons-fast 'rv base-case-expr nil) rv-predicate-formals)))
                         :rule-classes nil
                         :hints (("Goal"
                                  :do-not '(generalize eliminate-destructors)
                                  :in-theory (union-theories
                                              (theory 'minimal-theory)
                                              '(,proved-final-claim-name
                                                ,rv-predicate-name
                                                ,better-invariant-name
                                                (:rewrite nth-of-cons-constant-version) ;other list lemmas?
                                                (:executable-counterpart zp)
                                                (:executable-counterpart binary-+))))))

                       ;;proves that the exit test and invar imply the rv pred of the base case (easy)
                       (defthm ,exit-test-and-better-invar-imply-rv-predicate-theorem-name
                         (implies (and ,exit-test-expr
                                       (,better-invariant-name ,@better-invariant-formals))
                                  (,rv-predicate-name ,@(sublis-var-simple-lst (acons-fast 'rv base-case-expr nil) rv-predicate-formals)))
                         :rule-classes nil ;Tue Jan 11 17:00:19 2011
                         :hints (("Goal"
                                  :do-not '(generalize eliminate-destructors)
                                  :use ( ;;,better-invariant-theorem-name ;could separate into two steps..
                                        ,proved-final-claim-lemma-name
                                        ,proved-final-claim-implies-rv-predicate-theorem-name)
                                  :in-theory (theory 'minimal-theory))))

                       ;; Prove that the function call obeys the rv-predicate:
                       ;; The main induction proof!
                       (defthm ,fn-obeys-rv-predicate-theorem-name
                         (implies ,better-invariant-call ;;;invariant-call-on-formals-and-old-vars
                                  (,rv-predicate-name ,@(sublis-var-simple-lst (acons-fast 'rv fn-call nil) rv-predicate-formals)))
                         :rule-classes nil
                         :hints (("Goal"
                                  :induct (,fn ,@formals)
                                  :do-not '(generalize eliminate-destructors)
                                  :in-theory (union-theories
                                              (theory 'minimal-theory)
                                              '(,fn)))
                                 (and stable-under-simplificationp
                                      '(:use (,exit-test-and-better-invar-imply-rv-predicate-theorem-name
                                              ,updates-preserve-better-invariant-theorem-name)
                                             :do-not '(generalize eliminate-destructors)
                                             :in-theory (theory 'minimal-theory)))))

                       ;; Substitute for the old-vars:
;ffixme drop the invariant conjuncts that link the old vars to their old values (after we instantiate, these will be trivial?)
                       (defthm ,fn-obeys-rv-predicate-theorem-name-no-old-vars
                         (implies ,better-invariant-call-no-old-vars ;invariant-call-on-formals-no-old-vars
                                  (,rv-predicate-name ,@(sublis-var-simple-lst (acons-fast 'rv fn-call old-var-to-formal-alist) rv-predicate-formals)))
                         :rule-classes nil
                         :hints (("Goal" :use ((:instance ,fn-obeys-rv-predicate-theorem-name
                                                          ,@(make-alist-into-bindings (keep-entries old-vars-in-invariant old-var-to-formal-alist))))
                                  :do-not '(generalize eliminate-destructors)
                                  :in-theory (theory 'minimal-theory))))

                       ;; just opens up the rv predicate?
                       (defthm ,fn-obeys-rv-predicates-helper-theorem-name
                         (implies ,better-invariant-call-no-old-vars ;,invariant-call-on-formals-no-old-vars
                                  (and ,@conjuncts-for-rv-predicate-instantiated))
                         :rule-classes nil
                         :hints (("Goal"
                                  :use (:instance ,fn-obeys-rv-predicate-theorem-name-no-old-vars)
                                  :in-theory (union-theories
                                              (theory 'minimal-theory)
                                              '(,rv-predicate-name)))))

                       ;;this is also used to strengthen connections when proving a lemma connecting this function to another one
;fixme store this in the analyzed function table?
                       ;;The main theorem about the function:
                       ;;(expands the invariant from the theorem above and adds work-hard to each conjunct):
                       ;;fffixme put in free vars so things will match??
                       (defthm ,fn-obeys-rv-predicates-theorem-name
                         (implies (and ,@(wrap-all
                                          'work-hard
                                          (sublis-var-simple-lst (pairlis$ better-invariant-formals (fargs better-invariant-call-no-old-vars)) ;awkward?
                                                             better-proved-invars)))
                                  (and ,@conjuncts-for-rv-predicate-instantiated))
                         :hints (("Goal"
                                  :use (:instance ,fn-obeys-rv-predicates-helper-theorem-name)
                                  :in-theory (union-theories
                                              (theory 'minimal-theory)
                                              '(work-hard ,better-invariant-name))))))
                     state)))
        (mv (erp-nil)
            `(,better-invariant-name ; needed if we do a proof about connecting this loop to another one
              ,fn-obeys-rv-predicates-theorem-name)
            nil ;unchanged-runes ;ffixme what should happen with this now?
            nil ;Thu Feb 17 02:20:27 2011 ;(list invariant-name) ;needed? if so, include better-invariant-name?
            ;;do we use this? yes, when proving the connection lemma
            (prog2$ (cw "(Storing info for ~x0.)~%" ;(keep-entries old-vars-in-invariant old-var-to-formal-alist)
                        fn)
                    (s fn
                       (s :action :proved-invariant
                          (s :formal-shape-alist formal-shape-alist
                             (s :unchanged-components probably-unchanged-components ;fixme omit any that failed to prove?
                                (s :invariant-name better-invariant-name
                                   (s :updates-preserve-invariant-theorem-name updates-preserve-better-invariant-theorem-name
                                      (s :main-theorem-name fn-obeys-rv-predicates-theorem-name
                                         (s :explanation-graph explanation-graph
;keep only the info about old-vars that appear in the invariant because that is what's used
                                            (s :old-var-to-formal-alist (keep-entries old-vars-in-invariant old-var-to-formal-alist)
                                               (g fn analyzed-function-table) ;maybe fn never has an entry already?
                                               ))))))))
                       analyzed-function-table))
            rand state)))))


;;returns (mv erp miter-array miter-len) where the top node of the returned miter is equivalent to the top node of the miter passed in
;there should be no gaps in the miter node numbering (propagate this annotation out)
;fffixme: add support for rules with hyps
(defun apply-rule-at-nodenum (rule-symbol
                              nodenum
                              alist ;binds vars to terms over var, nodenums, and quoteps
                              miter-array-name
                              miter-array
                              miter-len state)
  (declare (xargs :guard (and (symbolp rule-symbol)
                              (natp nodenum)
                              (pseudo-dag-arrayp miter-array-name miter-array miter-len)
                              (< nodenum miter-len))
                  :stobjs state
                  :verify-guards nil ; todo
                  ))
  (b* (((mv lhs rhs) (lhs-and-rhs-of-simple-rule rule-symbol (w state)))
       ;; unify rule with the node
       (fail-or-alist (unify-term-and-dag-item2-with-name lhs nodenum miter-array-name miter-array miter-len)))
    (if (eq :fail fail-or-alist)
        (prog2$ (hard-error 'apply-rule-at-nodenum "rule does not apply at that node." nil)
                (mv (erp-t) miter-array miter-len))
      ;;it unifies.  make sure alist is consistent:
      (if (not (consistent-alists alist fail-or-alist))
          (prog2$ (hard-error 'apply-rule-at-nodenum "inconsistent alists." nil)
                  (mv (erp-t) miter-array miter-len))
        ;;make auxiliary data structures (we will be adding nodes to the miter dag):
        (b* ((miter-parent-array-name 'miter-parent-array) ;possible name clash?
             ((mv miter-parent-array miter-constant-alist miter-variable-alist)
              (make-dag-indices miter-array-name miter-array miter-parent-array-name miter-len))
             (original-miter-len miter-len)
             ;;the cdrs of the alist may be terms; add them to the dag and replace them with the nodenums
             ((mv erp alist miter-array miter-len miter-parent-array miter-constant-alist miter-variable-alist)
              (add-alist-cdrs-to-dag alist miter-array miter-len miter-parent-array miter-constant-alist miter-variable-alist miter-array-name miter-parent-array-name nil))
             ((when erp) (mv erp miter-array miter-len))
             (whole-alist (append alist fail-or-alist)) ;this is the whole alist to use (its cdrs are nodenums/quoteps)
             (instantiated-rhs (sublis-var-simple whole-alist rhs)) ;todo: instead pass an alist to merge-tree-into-dag-array?
             )
          (if nil ;;check the whole rhs for any remaining vars!
              (prog2$ (hard-error 'apply-rule-at-nodenum "free vars in rhs." nil)
                      (mv (erp-t) miter-array miter-len))
            (b* ( ;;add the instantiated rhs to the dag:
                 ((mv erp nodenum-or-quotep miter-array miter-len miter-parent-array miter-constant-alist miter-variable-alist)
                  (merge-tree-into-dag-array instantiated-rhs
                                             nil
                                             miter-array miter-len miter-parent-array miter-constant-alist miter-variable-alist miter-array-name miter-parent-array-name
                                             nil ;fixme
                                             ))
                 ((when erp) (mv erp miter-array miter-len))
                 ;;rebuild all the nodes above nodenum:
                 (renaming-array (new-array1 'renaming-array original-miter-len))
                 (renaming-array (aset1-safe 'renaming-array renaming-array nodenum nodenum-or-quotep))
                 ((mv erp miter-array & & & & ;; miter-len miter-parent-array miter-constant-alist miter-variable-alist
                      renaming-array)
                  (rebuild-node-range (+ 1 nodenum)
                                      (+ -1 original-miter-len)
                                      (+ -1 nodenum) ;max nodenum that is not renamed
                                      renaming-array
                                      miter-array miter-len miter-parent-array miter-constant-alist miter-variable-alist
                                      miter-array-name miter-parent-array-name))
                 ((when erp) (mv erp miter-array miter-len))
                 (renamed-top-node (aref1 'renaming-array renaming-array (+ -1 original-miter-len))))
              (mv (erp-nil) miter-array (+ 1 renamed-top-node)) ;all nodes above the renamed top node will be considered irrelevant
              )))))))

(skip-proofs (verify-guards apply-rule-at-nodenum))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Returns (mv provedp state).
;todo: consider othe proofs methods, like rewriting, using the axe-prover, using contexts (should we cut the context too -- what if the context is huge and unrelated to the goal nodes?), etc.
;not currently doing any of these things because we want this to be fast.
;; TTODO: pass in assumptions (e.g., bvlt claims) - should we cut the assumptions too?
;; TODO: Return the counterexample, if any.
(defun try-to-prove-pure-nodes-equal (smaller-nodenum
                                      larger-nodenum ; could either node have been replaced by a constant?
                                      miter-array-name miter-array miter-len
                                      var-type-alist
                                      print max-conflicts miter-name state)
  (declare (xargs :guard (and (natp smaller-nodenum)
                              (natp larger-nodenum)
                              (<= smaller-nodenum larger-nodenum)
                              (pseudo-dag-arrayp miter-array-name miter-array miter-len)
                              (< smaller-nodenum miter-len)
                              (< larger-nodenum miter-len)
                              (var-type-alistp var-type-alist)
                              (print-levelp print) ; tighten?
                              (or (null max-conflicts) (natp max-conflicts))
                              (symbolp miter-name))
                  :stobjs state))
  ;; todo: do more, like rewriting the (top node of) the equality
  (b* ((- (and (print-level-at-least-tp print)
               (b* (;;(- (and print (cw "(Subdag that supports the nodes:~%")))
                    ;;(- (and print (print-dag-array-nodes-and-supporters miter-array-name miter-array miter-len (list smaller-nodenum larger-nodenum))))
                    ;;(- (and print (cw ")~%")))
                    ;; Print info about vars that support only one of the 2 nodes (unusual, may indicate missing rules or inadequate test cases):
                    ;; TODO: Option to suppress this for speed?
                    ;;todo: move this printing to the caller?
                    (vars-for-smaller-nodenum (vars-that-support-dag-node smaller-nodenum miter-array-name miter-array miter-len))
                    (vars-for-larger-nodenum (vars-that-support-dag-node larger-nodenum miter-array-name miter-array miter-len))
                    (vars-that-support-only-larger-node (set-difference-eq vars-for-larger-nodenum vars-for-smaller-nodenum))
                    (vars-that-support-only-smaller-node (set-difference-eq vars-for-smaller-nodenum vars-for-larger-nodenum))
                    ;; (vars-that-support-both-nodes (intersection-eq vars-for-smaller-nodenum vars-for-larger-nodenum))
                    ;; (- (cw "(Vars that support both nodes: ~x0.)~%" vars-that-support-both-nodes))
                    (- (and vars-that-support-only-smaller-node (cw "(Vars that support node ~x0 only: ~x1.)~%" smaller-nodenum vars-that-support-only-smaller-node)))
                    (- (and vars-that-support-only-larger-node (cw "(Vars that support node ~x0 only: ~x1.)~%" larger-nodenum vars-that-support-only-larger-node))))
                 nil))))
    (try-to-prove-pure-nodes-equal-with-stp smaller-nodenum larger-nodenum miter-array-name miter-array miter-len var-type-alist print max-conflicts miter-name state)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;Rewrites [the top miter node only], then calls STP:
;; Returns (mv erp provedp state).
;; old: Smashes 'dag-array
;; todo: use context and assumptions
;; todo: return whether the attempt timed out some-goal-timed-outp
;; todo: consider using cutting heuristics
;; todo: return any counterexample, for use in splitting more node pairs
(defun try-to-prove-pure-node-is-constant (constant-value ;not quoted
                                           nodenum
                                           miter-array-name miter-array miter-len
                                           var-type-alist print
                                           ;; interpreted-function-alist
                                           ;; rewriter-rule-alist
                                           ;; assumptions
                                           ;; monitored-symbols
                                           max-conflicts miter-name state)
  (declare (xargs :guard (and (natp nodenum)
                              (pseudo-dag-arrayp miter-array-name miter-array miter-len)
                              (< nodenum miter-len)
                              (var-type-alistp var-type-alist)
                              (print-levelp print)
                              ;; (interpreted-function-alistp interpreted-function-alist)
                              ;; (rule-alistp rewriter-rule-alist)
                              ;; (pseudo-term-listp assumptions)
                              ;; (symbol-listp monitored-symbols)
                              (or (null max-conflicts) (natp max-conflicts))
                              (symbolp miter-name))
;                  :mode :program ; todo: because we call simplify-tree-and-add-to-dag-wrapper (try the basic rewriter?)
                  :stobjs state)
           ;; (ignore assumptions interpreted-function-alist rewriter-rule-alist monitored-symbols)
           )
  (b* (
       ;; ;; First try to simplify the equality of the node and the constant:
       ;; ;; TODO: This step seems slow and maybe not worth it for a pure node
       ;; (- (cw "Making the equality and rewriting (but only the top node).~%"))
       ;; ;;ffixme should we instead call the dag prover here, in case the assumptions are not simplified?
       ;; ;;ffixme don't do this for pure mode, since it's supposed to be fast?...:
       ;; ;;ffffixme need to pass in the array name for this?!:
       ;; ;;              (context-assumptions (and use-context-when-miteringp
       ;; ;;                                        (get-context-assumptions-for-nodenum nodenum miter-array miter-len)))

       ;; ;;ffixme eventually pass the miter-array to the rewriter (but don't overwrite any existing nodes), but for now the rewriter can only work on an array named 'dag-array
       ;; (dag-array (new-array1 'dag-array miter-len ;(+ 1 nodenum) using this caused a problem in make-dag-indices (in simplify-tree-and-add-to-dag-wrapper??) ffffixme
       ;;                              ))
       ;; (dag-array (copy-array-vals nodenum miter-array-name miter-array 'dag-array dag-array)) ;fixme only copy the supporting values?  we basically already computed the supporters when we did the purity check
       ;; ((mv erp miter-nodenum-or-quotep dag-array
       ;;      & ;dag-len-after-rewrite ;okay to ignore?
       ;;      state)
       ;;  (simplify-tree-and-add-to-dag-wrapper `(equal ',constant-value ,nodenum)
       ;;                                        dag-array
       ;;                                        miter-len ;use a smaller value?
       ;;                                        rewriter-rule-alist ;ffixme think about this
       ;;                                        assumptions ;(append context-assumptions assumptions)
       ;;                                        interpreted-function-alist
       ;;                                        monitored-symbols
       ;;                                        t ;fixme?
       ;;                                        print
       ;;                                        'ffixme
       ;;                                        state))
       ;; ((when erp) (mv erp nil state))
       ;; ((when (quotep miter-nodenum-or-quotep))
       ;;  (if (equal *t* miter-nodenum-or-quotep)
       ;;      (prog2$ (cw "The equality rewrote to true, which proves that node ~x0 is the constant ~x1.~%" nodenum constant-value)
       ;;              (mv (erp-nil) t state))
       ;;    (if (equal *nil* miter-nodenum-or-quotep)
       ;;        (prog2$ (cw "!! The equality rewrote to false. We have failed to prove that node ~x0 is the constant ~x1.~%" ;should this be an error?
       ;;                    nodenum constant-value)
       ;;                (mv (erp-nil) nil state))
       ;;      (prog2$
       ;;        (er hard? 'try-to-prove-node-is-constant "!! ERROR The equality rewrote to a constant other than t or nil, namely ~x0.  This should never happen.  Contact the implementor.~%" miter-nodenum-or-quotep)
       ;;        (mv (erp-t) nil state)))))
       ;; ;;The equality didn't rewrite to a constant:
       ;; (- (and (eq :verbose! print)
       ;;         (prog2$ (cw "Equality rewrote to:~%")
       ;;                 (print-dag-array-node-and-supporters 'dag-array dag-array miter-nodenum-or-quotep))))
       ;; ;;fixme use miter-nodenum-or-quotep below here?
       ;; ;;fixme use the fact that the miter is pure!
       ;; ;;There are no recursive fns, but there might still be non-bv/array fns: fixme expand any non-rec fns?
       ;; ;;fixme check all indices and sizes...
       ;; ((when (not (or (natp constant-value) ;; todo: check this earlier?  todo: allow a constant array?
       ;;                 (booleanp constant-value))))
       ;;  ;;is this checked when we check for pure miters?
       ;;  ;; The constant-value isn't a natural or boolean (fixme support more stuff here??... arrays?):
       ;;  (prog2$ (hard-error 'try-to-prove-node-is-constant
       ;;                      "Found a constant we don't yet handle: ~x0 for nodenum: ~x1.~%"
       ;;                      (acons #\1 nodenum (acons #\0 constant-value nil)))
       ;;          (mv (erp-t) nil state)))
       ;; ;; The constant is okay, so call STP:
       ;; ;; TODO: Use the cutting heuristics (put in vars for uninteresting subterms)? binary search to find the cut depth?
       ;; ;; TTODO: Need to handle vars not given types in the alist (look how they are used and infer a type?)
       ((mv result state)
        (prove-node-is-constant-with-stp nodenum constant-value miter-array-name miter-array miter-len var-type-alist print max-conflicts miter-name state)))
    (if (eq *error* result)
        (mv (erp-t) nil state)
      (if (eq *valid* result)
          (mv (erp-nil) t state)
        (mv (erp-nil) nil state)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;
;; the main mutual-recursion of the Axe Equivalence Checker (fixme should more stuff above use this to prove goals by mitering?):
;;

;todo: use better erps than t here in the error cases.  maybe get rid of :error since we now have the erp return value
;todo: thread through a parent array for the miter and use it to fixup parents when merging constant nodes (could also evaluate ground terms?).  would need to maintain the parent array as we merge...
(mutual-recursion

 ;; TODO: Continue changing dag-lst to either dag or dag-or-quotep within this

 ;; Attempt to prove the theorem by rewriting and then calling the equivalence checker (miter-and-merge)
 ;;fixme should this simplify the assumptions at all (could help prevent loops)?  should this expand the assumptions (e.g., when they are calls to an invariant or connection relation, negated calls to an exit test, etc.)?
 ;;returns (mv erp provedp rand state) where if PROVEDP is non-nil, then the indicated theorem has been proved in STATE
 (defun prove-theorem (conclusion ;a term
                       hyps       ;terms
                       hyps-that-can-fail ;subset of hyps (do we still use this feature?)
                       defthm-name        ; a symbol
                       rewriter-rule-alist
                       prover-rule-alist
                       extra-stuff
                       interpreted-function-alist ;fixme does this appear in the generated theorem?  should it? should we extract this from the state?
                       test-cases ;below we filter these to only keep the ones that satisfy the hyps (fixme may not need to do this if i change things to not pass in bad test cases?)
                       miter-depth-to-use ;helps keep the array names straight
                       print monitored-symbols
                       analyzed-function-table
                       unroll
                       make-theoremp max-conflicts
                       options
                       rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (b* ((- (cw "(Proving conclusion ~x0:~%" defthm-name)) ;fixme check the print arg before printing much?
        (- (and print (prog2$ (print-term-nice conclusion) (cw "~%"))))
        (- (and print (cw "(Hyps: ~x0~%)" hyps))) ;fixme print hyps that can fail
        (- (cw "(Print: ~x0.)~%" print))
        (- (cw "(Rewriting:~%"))
        ((mv erp conclusion-dag-lst) (make-term-into-dag conclusion interpreted-function-alist))
        ((when erp) (mv erp nil rand state))
        ((mv erp provedp rand state)
         (b* (;; First we simplify the conclusion (this opens up any -update functions, etc.):
              ((mv erp conclusion-dag-lst state)
               ;;ffixme can we skip this special case?  does miter-and-merge simplify first?
               ;;ffixme i've seen this loop if there are loops in the hyps..
               ;;fixme concretize and rewrite until stable?
               (simp-dag conclusion-dag-lst ;just call simplify-term?
                         :rule-alist rewriter-rule-alist
                         :print print ; fixme this can sometimes print the result, which is printed again below?
                         :assumptions hyps
                         :monitor monitored-symbols ;fixme don't monitor if we're not using contexts?
                         :interpreted-function-alist interpreted-function-alist ;Fri Sep  3 05:00:35 2010
                         ;;fixme what other options?
                         ;;fffffixme pass in use-internal-contextsp?
                         :work-hard-when-instructedp nil ;Sun Sep 19 18:07:29 2010 since we haven't handled the rec fns yet..
                         :check-inputs nil
                         ))
              ((when erp) (mv erp nil rand state))
              (- (cw "Done rewriting.)~%")))
           (if (quotep conclusion-dag-lst) ;remove these checks?
               (if (unquote conclusion-dag-lst)
                   (prog2$ (cw "Proved claim ~x0 (rewrote to ~x1)!~%" defthm-name conclusion-dag-lst) ;print warning if other than 't ?
                           (mv nil t rand state))
                 (prog2$ (cw "!! Failed to prove claim ~x0 (Rewrote to false!)~%" defthm-name) ;should this be an error?
                         (mv nil nil rand state)))
             ;;Didn't rewrite to a constant, so do mitering and merging: ;fixme just pass the constant to miter-and-merge?
             (progn$ (cw "(Simplified miter for claim ~x0:~%" defthm-name)
                     (print-list conclusion-dag-lst) ;fixme remove newlines before close parens
                     (cw ")~%(Calling the Equivalence Checker:~%")
                     ;;ffffixme should we call the dag prover here? what if some hyps need to be simplified?
                     (mv-let (erp provedp rand state)
                       ;;fffixme maybe miter-and-merge should start with a simplification pass? - then wouldn't have to do it above - or call prove-with-axe-fn?
                       ;;ffixme pass in the right args here:
                       ;;should miter and merge start with a single call to the prover??
                       ;;return a new analyzed-function-table?
                       (miter-and-merge conclusion-dag-lst
                                        (pack$ defthm-name '-miter)
                                        miter-depth-to-use
                                        (make-var-type-alist-from-hyps hyps) ;used if we need to call STP
                                        interpreted-function-alist
                                        print
                                        nil ;debug-nodes (or pass these around?)
                                        rewriter-rule-alist
                                        prover-rule-alist
                                        hyps
                                        extra-stuff
                                        (keep-test-cases-that-satisfy-hyps test-cases hyps interpreted-function-alist 0 nil hyps-that-can-fail)
;fixme check whether any test cases remain.  if not, we could try to show the hyps contradict?
;or should that be an error?
;fixme if we are calling prove-theorem on many goals with the same hyps, it would be faster to filter the hyps once.. maybe we do that now..
                                        monitored-symbols
                                        t ;use-context-when-miteringp
                                        analyzed-function-table
                                        unroll
                                        512 ;tests-per-case fixme!
                                        max-conflicts
                                        nil ;must-succeedp=nil
                                        t
                                        nil ;simplify xors
                                        options
                                        rand state)
                       (if erp
                           (mv erp nil rand state)
                         (if provedp
                             (prog2$ (cw "Proved claim ~x0 by mitering.)~%" defthm-name)
                                     (mv nil t rand state))
                           ;;should this be an error?
                           (prog2$ (cw "!! Failed to prove claim ~x0.)~%" defthm-name)
                                   (mv nil nil rand state)))))))))
        ((when erp) (mv erp nil rand state)))
     (if provedp
         (if (not make-theoremp)
             (prog2$ (cw "(Not actually making the theorem ~x0.))~%" defthm-name)
                     (mv nil t rand state))
           (prog2$ (cw "Making the theorem ~x0:~%" defthm-name)
                   (let ((state
                          (submit-event-brief
                           ;;where should this go?  should we use a clause processor?
                           ;;ffixme perhaps miter-and-merge should submit the defthm??
                           ;;skip-proofs here are bad?
                           `(skip-proofs (defthm ,defthm-name
                                           (implies (and ,@hyps) ;,(make-conjunction-from-list hyps)
                                                    ,conclusion)
                                           :rule-classes nil))
                           state)))
                     (prog2$ (cw ")~%")
                             (mv nil t rand state)))))
       (prog2$ (cw "FAIL Not making the theorem ~x0.)~%" defthm-name) ;should this be an error?
               (mv nil nil rand state)))))

 ;; returns (mv erp provedp defthm-name rand state)
;fixme replace with something more general-purpose
;add tagging?
 ;; should this return any defthms it proves about nested functions?  those will already be proved in state, right?
 (defun prove-invar-from-invars (invar ;we'll prove this holds after the update
                                 base-theorem-name formal-update-expr-alist
                                 hyps ;all-invars negated-exit-test ;pass these two in together?
                                 invar-set-num invar-num rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars
                                 miter-depth-to-use ;depth to use if this needs to miter ;helps keep the array names straight
                                 unroll monitored-symbols print
                                 make-theoremp max-conflicts
                                 options
                                 rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (let ((defthm-name (packnew base-theorem-name invar-set-num '-invar-num- invar-num)))
     (mv-let (erp provedp rand state)
       ;;fixme  perhaps pre-simplify first?
       (prove-theorem (sublis-var-simple formal-update-expr-alist invar)
                      hyps ;(cons negated-exit-test all-invars)
                      nil  ;(list negated-exit-test)
                      defthm-name rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist
                      test-cases-for-formals-and-old-vars
                      miter-depth-to-use
                      print
                      monitored-symbols
                      (empty-analyzed-function-table) ;fffixme think about what analysis we should do for nested loops...
                      unroll
                      ;;fixme pass in rule-classes!
                      make-theoremp max-conflicts
                      options
                      rand state)
       (if erp
           (mv erp nil nil rand state)
         (if provedp
             (mv nil t defthm-name rand state)
           (prog2$ (cw "(FAILED to prove claim (need to discard something) ~x0.)~%" invar)
                   (mv nil nil nil rand state)))))))

 ;;   (let ((defthm-name (pack$ fn '-invariant-set- invar-set-num '-invar-num- invar-num)))
 ;;     (mv-let (failedp state)
 ;;             (my-defthm defthm-name
 ;;                        (append assumptions all-invars-in-set)
 ;;                        (list (sublis-var-simple formal-update-expr-alist invar)) ;would be nice to avoid the list here
 ;;                        :rule-classes nil
 ;;                        :hints `(("Goal"
 ;;                                  :in-theory (theory 'minimal-theory)
 ;;                                  :do-not '(generalize eliminate-destructors)
 ;;                                  ;;ffixme skip the clause processor and just call axe-prover (or some other similar function) directly?
 ;;                                  ;;fffixme what if this proof requires mitering to be done (e.g, to deal with nested loops)?
 ;;                                  ;ffixme call prove-theorem? perhaps pre-simplify first?
 ;;                                  :clause-processor
 ;;                                  (axe-prover
 ;;                                   clause
 ;;                                   ',(s :unroll unroll
 ;;                                        (s :goal-name defthm-name
 ;;                                           (s :print :brief ;t ;:verbose
 ;;                                              (s :monitor  monitored-symbols
 ;;                                                 (axe-prover-hints
 ;;                                                  nil
 ;;                                                  prover-rule-alist interpreted-function-alist
 ;;                                                  ;;fffixme does this not capture information from enough traces (what if most of the test cases come from 1 trace?)
 ;;                                                  (firstn 1007 test-cases-for-formals) ;fixme there may be 1000s of cases (one for each recursive call of the surrounding function?)
 ;;                                                  (empty-analyzed-function-table) ;fffixme think about what analysis we should do for nested loops...
 ;;                                                  )))))
 ;;                                   state))))
 ;;             (if failedp
 ;;                 (prog2$ (cw "FAILED to prove invariant ~x0.~%" invar)
 ;;                         (mv nil nil state))
 ;;               (mv t defthm-name state))))

 ;; Returns (mv erp invariants-that-failed defthm-names rand state).
 (defun find-failed-invariants (invars hyps base-theorem-name formal-update-expr-alist
                                       invar-set-num invar-num
                                       rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use
                                       unroll monitored-symbols print acc defthm-names-acc max-conflicts options rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (if (endp invars)
       (mv nil acc defthm-names-acc rand state)
     (let* ((invar (first invars)))
       (mv-let (erp provedp defthm-name rand state)
         (prove-invar-from-invars invar base-theorem-name formal-update-expr-alist
                                  hyps
                                  invar-set-num invar-num
                                  rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use unroll monitored-symbols print
                                  t ;nil ;don't make the defthm
                                  max-conflicts
                                  options
                                  rand state)
         (if erp
             (mv erp nil nil rand state)
           (find-failed-invariants (rest invars) hyps base-theorem-name formal-update-expr-alist
                                   invar-set-num
                                   (+ 1 invar-num)
                                   rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use
                                   unroll monitored-symbols print
                                   (if provedp acc (cons invar acc)) ;add this invar to the result if it failed
                                   (if provedp (cons defthm-name defthm-names-acc) defthm-names-acc)
                                   max-conflicts options rand state))))))

;returns (mv erp invariants-that-failed defthm-names rand state), where if invariants-that-failed is nil then they all proved and defthm-names are the theorem-names showing that they are preserved by the updates
;otherwise, invariants-that-failed are all the members of invars that failed to be proved (safe to throw them all out) and defthm-names is meaningless
;ffixme inline this?
 (defun try-to-prove-invariant-set-inductive (invars base-theorem-name formal-update-expr-alist
                                                     hyps
                                                     invar-set-num rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist
                                                     test-cases-for-formals-and-old-vars
                                                     miter-depth-to-use
                                                     unroll monitored-symbols print max-conflicts options rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (progn$ (cw "(Trying to prove inductive set of length ~x0.~%" (len invars))
           (cw "(Trying to prove them all at once:~%")
           ;;first try proving the conjunct of all the invars (might be much faster than proving each one separately, since nested functions would be analyzed only once..):
;ffixme consider tagging the individual invars with identity wrappers (perhaps the function identity with a tag for the number of the invar), so we can quickly see which ones failed
           ;; could rewriting mess up the tags? substituting?
           (mv-let (erp proved-allp defthm-name rand state)
             (prove-invar-from-invars (make-conjunction-from-list invars) base-theorem-name formal-update-expr-alist
                                      (append hyps invars)
                                      invar-set-num
                                      "ALL" ;; invar-num
                                      rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use unroll monitored-symbols print
                                      t max-conflicts options rand state)
             (if erp
                 (mv erp nil nil rand state)
               (if proved-allp
                   (prog2$ (cw "Proved them all at once.))~%")
                           (mv nil
                               nil ;no invariant failed
                               (list defthm-name) ;ffixme should we split this into separate conjuncts?
                               rand state))
                 ;;they didn't all prove, so do them one at a time to see which ones failed:
                 ;;if there is only one, don't try that one again
                 (prog2$ (cw "At least one failed.  Trying them one at at time:)~%")
                         (mv-let (erp invariants-that-failed defthm-names rand state)
                           (find-failed-invariants invars (append hyps invars) base-theorem-name formal-update-expr-alist
                                                   invar-set-num 0 rewriter-rule-alist prover-rule-alist
                                                   extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use
                                                   unroll monitored-symbols print nil nil max-conflicts options rand state)
                           (if erp
                               (mv erp nil nil rand state)
                             ;;It's possible that they fail to prove together but each proves individually, so we do make the theorems
                             (progn$ (cw "Discarding failed claims:~%")
                                     (print-list invariants-that-failed)
                                     (cw ")~%")
                                     (mv nil
                                         invariants-that-failed ;may be nil
                                         defthm-names
                                         rand state))))))))))

 ;; Returns (mv erp inductive-invars defthm-names rand state)
;make a wrapper that takes the first ~1000 test cases (but maybe does a better job, making sure they come from multiple traces, etc.)
 ;; This tries to prove all of the invariants.  If that fails, this removes the ones that failed and tries again, until it finds and inductive set.
;fixme should this take the analyzed-function-table?  think about what should happen with nested loops
 (defun find-maximal-inductive-set-of-invars (invars base-theorem-name formal-update-expr-alist
                                                     hyps
                                                     invar-set-num rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars
                                                     miter-depth-to-use
                                                     unroll monitored-symbols print max-conflicts options rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (mv-let (erp invariants-that-failed defthm-names rand state)
     (try-to-prove-invariant-set-inductive invars base-theorem-name formal-update-expr-alist hyps
                                           invar-set-num rewriter-rule-alist prover-rule-alist
                                           extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use
                                           unroll monitored-symbols print max-conflicts options rand state)
     (if erp
         (mv erp nil nil rand state)
       (if invariants-that-failed
           (find-maximal-inductive-set-of-invars (set-difference-equal invars invariants-that-failed)
                                                 base-theorem-name formal-update-expr-alist
                                                 hyps
                                                 (+ 1 invar-set-num)
                                                 rewriter-rule-alist prover-rule-alist extra-stuff interpreted-function-alist test-cases-for-formals-and-old-vars miter-depth-to-use
                                                 unroll monitored-symbols print max-conflicts options rand state)
         (mv nil invars defthm-names rand state)))))

 ;; ;fixme change things to prove the first theorem here with the connection relation open!  (and maybe also the negated exit test?)
 ;; ;returns (mv defthm-names state) where the named defthms have been proved in state
 ;; ;ffixme search for stable-under-simplificationp to find calls to the prover and replace with calls to prove-theorem?
 ;; ;fffixme shouldn't the invariant imply the connection relation? i guess this is for the new updates..
 ;;   ;;we could do the opening of the connection relation and invariant by rewriting the hyps...
 ;;   (defun prove-updates-preserve-connection-for-dropping (conjuncts ;each is over formals and new-formals and orig-vars?
 ;;                                                          invariant-conjuncts
 ;;                                                          connection-conjuncts
 ;;                                                          connection-relation-call
 ;;                                                          hyps
 ;;                                                          fn conjunct-number
 ;;                                                          invariant-name ;ffixme any irrelevant params in here?
 ;;                                                          invariant-call
 ;;                                                          connection-relation-name
 ;;                                                          new-update-fns ;so we can open them ;irrelevant?  drop?  other irrelevant params?
 ;;                                                          analyzed-function-table
 ;;                                                          rewriter-rule-alist prover-rule-alist
 ;;                                                          test-cases-for-formals ;Sat Mar  6 04:03:16 2010
 ;;                                                          interpreted-function-alist
 ;;                                                          unroll print
 ;;                                                          extra-stuff monitored-symbols
 ;;                                                          miter-depth-to-use
 ;;                                                          defthm-names-acc state)
 ;;     (declare (xargs :stobjs state :mode :program))
 ;;     (if (endp conjuncts)
 ;;         (mv (reverse defthm-names-acc) state)
 ;;       (let* ((conjunct (first conjuncts))
 ;;              (theorem-name (pack$ fn '-updates-preserve-connection-relation-conjunct-for-dropping- conjunct-number))
 ;;              (helper-theorem-name (pack$ theorem-name '-helper))
 ;;              (helper-2-theorem-name (pack$ theorem-name '-helper2))
 ;;              (all-hyps (append invariant-conjuncts
 ;; ;i am no longer opening this.  that replace params with an expression over new-params, but we have no hyps about new-params:
 ;;                                (list connection-relation-call) ;;connection-conjuncts ;newly opened up - i hope this never causes loops
 ;;                                hyps)))
 ;;         ;;first prove it with the expanded invariant:
 ;;         (mv-let (provedp state)
 ;;                 (prove-theorem conjunct
 ;;                                all-hyps
 ;;                                all-hyps ;fixme cut this down, if hyps should not be allowed to fail
 ;;                                helper-theorem-name
 ;;                                rewriter-rule-alist
 ;;                                prover-rule-alist
 ;;                                extra-stuff interpreted-function-alist
 ;;                                test-cases-for-formals
 ;;                                miter-depth-to-use ; 0 Wed Sep  8 08:19:20 2010
 ;;                                print monitored-symbols
 ;;                                analyzed-function-table
 ;;                                unroll
 ;;                                t   ;make-theoremp
 ;;                                state)
 ;;                 (if (not provedp)
 ;;                     (prog2$ (hard-error 'prove-updates-preserve-connection-for-dropping "failed to prove conjunct ~X01" (acons #\0 conjunct (acons #\1 nil nil)))
 ;;                             (mv nil state))
 ;;                   ;;this one just closes up the invariant:
 ;;                   (let ((state (submit-events-brief `((defthm ,helper-2-theorem-name
 ;;                                              (implies (and ,invariant-call
 ;;                                                            ,connection-relation-call ;;,@connection-conjuncts
 ;;                                                            ,@hyps)
 ;;                                                       ,conjunct)
 ;;                                              :rule-classes nil
 ;;                                              :hints (("Goal" :use (:instance ,helper-theorem-name)
 ;;                                                       :in-theory (union-theories (theory 'minimal-theory)
 ;;                                                                                  '(,invariant-name))))))
 ;;                                          state))) ;check for error?
 ;;                     ;;this one closes up the connection relation: fffixme no it doesn't!
 ;;                     (let ((state (submit-events-brief `((defthm ,theorem-name
 ;;                                                (implies (and ,invariant-call
 ;;                                                              ,connection-relation-call
 ;;                                                              ,@hyps)
 ;;                                                         ,conjunct)
 ;;                                                :rule-classes nil
 ;;                                                :hints (("Goal" :use (:instance ,helper-2-theorem-name)
 ;;                                                         :in-theory (union-theories (theory 'minimal-theory)
 ;;                                                                                    '( ;,connection-relation-name
 ;;                                                                                      ))))))
 ;;                                            state))) ;check for error?
 ;;                       (prove-updates-preserve-connection-for-dropping (rest conjuncts)
 ;;                                                                       invariant-conjuncts
 ;;                                                                       connection-conjuncts
 ;;                                                                       connection-relation-call
 ;;                                                                       hyps
 ;;                                                                       fn (+ 1 conjunct-number)
 ;;                                                                       invariant-name
 ;;                                                                       invariant-call
 ;;                                                                       connection-relation-name
 ;;                                                                       new-update-fns
 ;;                                                                       analyzed-function-table
 ;;                                                                       rewriter-rule-alist prover-rule-alist
 ;;                                                                       test-cases-for-formals
 ;;                                                                       interpreted-function-alist
 ;;                                                                       unroll print extra-stuff monitored-symbols miter-depth-to-use
 ;;                                                                       (cons theorem-name defthm-names-acc) state))))))))

 ;;            (state (submit-events-brief ;fixme abuse for 1 event?
 ;;                    `((defthm ,theorem-name
 ;;                        (implies (and ,@hyps)
 ;;                                 ,conjunct)
 ;;                        :rule-classes nil
 ;;                        :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
 ;;                                                                   '(,connection-relation-name
 ;;                                                                     ,invariant-name
 ;;                                                                     ,@new-update-fns
 ;;                                                                     ;;,(pack$ fn '-leibniz) ;add this?

 ;;                                                                     ;;gross to need to do all this list reasoning:
 ;;                                                                     ;;use a use hint?
 ;;                                                                     ;;,@(append (list-rules-etc) (list-rules2-executable-counterparts))
 ;;                                                                     )))
 ;;                                (and stable-under-simplificationp
 ;;                                     '(:clause-processor
 ;;                                       (axe-prover
 ;;                                        clause
 ;;                                        ',(s :unroll unroll
 ;;                                             (s :max-conflicts t ;Thu Aug 19 23:12:34 2010
 ;;                                                (s :print print
 ;;                                                   (s :goal-name theorem-name
 ;;                                                      (axe-prover-hints
 ;; ;since these are used to simplify the dag (make this list a constant?)
 ;;                                                       `(NTH-OF-CONS-CONSTANT-VERSION ;Fri Mar  5 00:14:42 2010
 ;;                                                         LOOKUP-EQUAL-OF-ACONS-DIFF
 ;;                                                         LOOKUP-EQUAL-OF-ACONS-SAME
 ;; ;,update-fn
 ;; ;,new-update-fn
 ;; ;,new-base-fn
 ;; ;,invariant-name
 ;; ;,connection-relation-name
 ;;                                                         )
 ;;                                                       prover-rule-alist
 ;;                                                       interpreted-function-alist ;Sun Mar  7 03:15:25 2010
 ;;                                                       (firstn 1010 test-cases-for-formals) ;Sat Mar  6 04:04:19 2010 ;Thu Mar 18 21:41:01 2010 ;fixme where should we trim this down?
 ;;                                                       analyzed-function-table)))))
 ;;                                        state)
 ;;                                       :do-not '(generalize eliminate-destructors))))))
 ;;                    state))
;           )



 ;; ;returns (mv result state)
 ;;   (defun make-new-update-expr-for-formal (new-formal update-expr new-components-in-terms-of-old-alist formal-replacement-alist interpreted-function-alist state)
 ;;     (declare (xargs :stobjs state
 ;;                     :mode :program
 ;;                     :verify-guards nil))
 ;;     (let ((match (lookup-eq new-formal new-components-in-terms-of-old-alist)))
 ;;       (if match
 ;;           ;;no components of this formal were dropped (the whole formal was just renamed), so we just fixup the update expression
 ;;           ;;to use the new formals
 ;;           (mv (sublis-var-simple formal-replacement-alist update-expr) state)
 ;;         ;; some components of this formal were dropped, so the new update expr will have a different shape than the old one:
 ;;         (let* ((new-highest-numbered-component (find-highest-numbered-component-key new-components-in-terms-of-old-alist new-formal 0))
 ;;                (new-update-expr (sublis-var-simple formal-replacement-alist update-expr)) ;in terms of new-params
 ;;                ;;now we handle the fact that some components are dropped:
 ;;                (new-update-expr-components (new-update-expr-components 0 new-highest-numbered-component new-formal new-update-expr new-components-in-terms-of-old-alist))
 ;; ;fffixme simplify this?! use a dag!? or make one big dag for all formals (this is just for 1 formal):
 ;;                (new-update-expr (make-cons-nest new-update-expr-components)))
 ;;           (if (call-of-user-fn-on-formalsp update-expr (strip-cars formal-replacement-alist))
 ;;               (prog2$ (cw "simplifying the update~%")
 ;;                       (mv-let (dag state)
 ;;                               (simplify-term3 new-update-expr
 ;;                                              (make-rule-alist `(,(ffn-symb update-expr)(:definition blah)  ;e.g., SHA1-LOOP-10-UPDATE
 ;;
 ;;                                                             (:rewrite NTH-OF-CONS-CONSTANT-VERSION) ;Fri Mar  5 00:14:42 2010
 ;;                                                             (:REWRITE LOOKUP-EQUAL-OF-ACONS-DIFF)
 ;;                                                             (:REWRITE LOOKUP-EQUAL-OF-ACONS-SAME)
 ;;                                                             ) state)
 ;;                                              :interpreted-function-alist interpreted-function-alist)
 ;;                               (mv
 ;;                                `(dag-val-with-axe-evaluator ',dag
 ;;                                                              ,(make-acons-nest (dag-vars-unsorted dag))
 ;;                                                              ',(supporting-interpreted-function-alist (dag-fns dag)
 ;;                                                                                                       interpreted-function-alist) 0)
 ;;                                state)))
 ;;             (mv new-update-expr state))))))

 ;; ;returns (mv result state)
 ;;   (defun make-new-update-exprs (new-formals update-exprs new-components-in-terms-of-old-alist formal-replacement-alist interpreted-function-alist state)
 ;;     (declare (xargs :stobjs state :verify-guards nil :mode :program))
 ;;     (if (endp new-formals)
 ;;         (mv nil state)
 ;;       (let* ((new-formal (car new-formals))
 ;;              (update-expr (car update-exprs)))
 ;;         (mv-let (result state)
 ;;                 (make-new-update-expr-for-formal new-formal update-expr new-components-in-terms-of-old-alist formal-replacement-alist interpreted-function-alist state)
 ;;                 (mv-let (results state)
 ;;                         (make-new-update-exprs (cdr new-formals) (cdr update-exprs) new-components-in-terms-of-old-alist formal-replacement-alist interpreted-function-alist state)
 ;;                         (mv (cons result results)
 ;;                             state))))))



 ;; this can transform the function (uncdr, peel off base case, unroll handle elsewhere!), drop params, or prove a lemma (anything else?)
 ;; Returns (mv erp result analyzed-function-table rand state) where result is :error, :failed, or (list new-runes new-fns).
 ;; The invariant produced here is also used when comparing two rec. fns. (unless the function is transformed here)
 ;;fixme all non-recursive functions should be blown away - check that?
 ;;fixme should some of the :error cases below just be :failed?
 ;;fixme - where do we generate type theorems?
 ;;fixme if there are several possible-rv-equalities, should we split them into several theorems? maybe they will need to all be proved together
 ;;do we not need type facts?  combine this with the f1-theorem and f2-theorem when proving f1 and f2 equivalent?
 ;;rename, since now it can put in type facts..
 ;;ffffixme what if the function has several params vs. one param that is a tuple?
 ;; a function with just one param won't wrap it in a list before returning it...
 ;;fixme if nodenum is surrounded by some fn, F, such as len, perhaps we should try to express F of the call at nodenum
 ;;fixme instead of result, this could extend the ifns alist and the list of rules (or rule alist?)
;todo: use erp more instead of the :error return val?
 (defun analyze-rec-fn (nodenum ; the nodenum of a (non-built-in) recursive function call
                        dag-array-name dag-array interpreted-function-alist
                        extra-stuff rewriter-rule-alist prover-rule-alist
                        test-cases ;each is an alist from input vars to values
                        test-case-array-alist ;can be invalid...
                        analyzed-function-table
                        unroll miter-depth-to-use monitored-symbols max-conflicts print
                        options
                        rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (let* ((expr (aref1 dag-array-name dag-array nodenum))
          (fn (ffn-symb expr))
          (dummy (cw " (Analyzing rec. fn. ~x0 at nodenum ~x1.~%" fn nodenum)))
     (declare (ignore dummy))
     ;;Check whether we have analyzed the function already:
     ;;ffixme what if the same function appears several times? remember the context somehow?   or rename to give each function a unique name?
     ;;ffixme we don't use the value in analyzed-function-table, just whether the function is bound to anything or not..
     (if (g fn analyzed-function-table) ;a non-nil entry means we've handled it by unrolling, proving a lemma, or proving an opener, etc.
         (prog2$ (cw "We have already analyzed the function ~x0 (~x1).)~%" fn (g :action (g fn analyzed-function-table)))
                 (mv nil (list nil nil) analyzed-function-table rand state))
       (let ((cdred-formals (find-cdred-formals fn state)))
         (if cdred-formals
             ;;if the function cdrs down a list, change it to one that leaves the list unchanged:
             (mv-let (new-runes new-fns state)
               (prog2$ (cw "(Removing cdring from ~x0 for params ~x1:~%" fn cdred-formals)
                       (remove-cdring-from-function fn cdred-formals state))
               (prog2$ (cw "Done removing cdring) Done with rec fn ~x0)~%" fn)
                       (mv nil
                           (list new-runes new-fns)
                           analyzed-function-table ;fixme add an entry to this?
                           rand state)))
           ;;ffixme check that the function makes only one recursive call?
;this also handles the case of more than one base case:
           (let* ((tail-recursivep (tail-recursivep fn state)))
             (if (and tail-recursivep (need-to-peel-off-base-casep fn state))
                 (prog2$ (cw "(Peeling off base case of ~x0.~%" fn)
                         (mv-let (erp result analyzed-function-table state)
                           (peel-off-base-case-of-tail-fn fn interpreted-function-alist analyzed-function-table state)
                           (if erp
                               (mv erp :error analyzed-function-table rand state)
                             (prog2$ (cw "Done peeling off base case.) Done with rec fn ~x0)" fn)
                                     (mv nil
                                         result
                                         analyzed-function-table
                                         rand state)))))
;fixme for axe to determine this automatically, it will need the other function to compare to, so move this stuff?
               (let* ((extra-stuff-for-fn (g fn extra-stuff))
                      (unrolling-factor (g :unrolling-factor extra-stuff-for-fn))) ;note: the unroll arg is only for complete unrolling
                 (if unrolling-factor
                     (prog2$ (cw "(Unrolling ~x0 by ~x1.~%" fn unrolling-factor)
                             (mv-let (unrolled-fn rune state)
                               (unroll-function fn unrolling-factor nil state)
                               (prog2$ (cw "Done unrolling)~%Handled rec fn ~x0 by unrolling)~%" fn)
                                       (mv nil
                                           (list (list rune)
                                                 (list unrolled-fn))
                                           analyzed-function-table rand state))))
                   (let* ((is-a-nice-tail-function-result (is-a-nice-tail-function fn state))
                          (nice-tail-functionp (first is-a-nice-tail-function-result)))
                     (if (not nice-tail-functionp)
                         ;; maybe it's a the head-recursive version of a list builders (special case if it's a defsequence function):
                         (let* ((dummy101 (cw "!! ~x0 is not a nice tail rec fn. !! ~%" fn)) ;bad msg?
                                (head-rec-list-builderp (head-rec-list-builderp fn state)))
                           (declare (ignore dummy101))
                           (let ((head-aux-fn-of-defsequence-result (head-aux-fn-of-defsequence fn (w state))))
                             (if head-aux-fn-of-defsequence-result
                                 ;;if it's the head recursive version of a defsequence, we already have the tail rec. version:
                                 (prog2$ (cw "Converting defsequence head-aux function ~x0 to tail-recursive.)~%" fn) ;the close-paren is new
                                         (mv nil
                                             (list (list `,(lookup-eq :head-aux-becomes-tail-aux-lemma-name
                                                                      (lookup-eq head-aux-fn-of-defsequence-result
                                                                                 (table-alist 'defsequence-table (w state)))))
                                                   ;;this gets the tail function into the ifns?:
                                                   (list (lookup-eq :tail-aux-name
                                                                    (lookup-eq head-aux-fn-of-defsequence-result
                                                                               (table-alist 'defsequence-table (w state))))))
                                             (s fn (s :action :converted-defsequence-head-to-tail (empty-map)) analyzed-function-table)
                                             rand state))
                               (if head-rec-list-builderp
                                   (mv-let (runes fns state)
                                     ;;This is now okay to do even for producer or consumer functions, because producer-consumer2.lisp shows how to handle tail rec producers and consumers.
                                     (prog2$
                                      (cw "(Converting list builder to be tail recursive:~%")
                                      (convert-list-builder-to-tail fn state))
                                     (progn$ (cw "Done making list builder tail recursive.)")
                                             (cw "Handled rec fn ~x0)~%" fn)
                                             (mv nil
                                                 (list runes fns)
                                                 (s fn (s :action :converted-list-builder-to-tail (empty-map)) analyzed-function-table)
                                                 rand state)))
                                 (prog2$ (cw ")")
                                         (mv nil
                                             :failed
                                             ;;fixme is this really an action?
                                             (s fn (s :action :head-rec-and-nothing-to-do (empty-map)) analyzed-function-table) ;there's no invariant to store about it....
                                             rand state))))))
                       ;;Tail-recursive function (with a trivial base-case):
                       (mv-let
                         (traces test-cases trace-count) ;drops test-cases for which the node is unused, so TRACES and TEST-CASES should be in sync
                         (get-traces-for-node nodenum dag-array-name dag-array interpreted-function-alist test-cases test-case-array-alist)
                         (if (< trace-count 2)
                             (prog2$ (cw "!! Only ~x0 trace(s), but we require at least 2 (consider adding more test cases, or perhaps this node is irrelevant due to an inconsistent context).)~%" trace-count) ;require more than 2?
                                     (mv nil :failed analyzed-function-table rand state))
                           (let* ( ;; fixme could we save consing in how we manipulate traces since now they will be simple loop fns?
                                  ;;fixme don't bother to add the RVs to the traces, since they will all be the same for tail-rec fns...
                                  (traces (flatten-traces traces)) ;delay this?
                                  (rep-counts (len-list traces))
                                  (real-rep-counts (sub1-list rep-counts)) ;removes 1 for the base case call from each total ;combine with the len-list?
                                  (dummy (progn$ (and ;print
                                                  (cw "(Loop body execution counts for ~x0 (min ~x2, max ~x3): First few: ~x1.)~%" fn (firstn 10 real-rep-counts)
                                                      (if real-rep-counts (minelem real-rep-counts) 0)
                                                      (if real-rep-counts (maxelem real-rep-counts) 0)))
                                                 (and nil ;print
                                                      (cw "(First 10 test-cases for ~x0: ~x1.~%)" fn (firstn 10 test-cases)))))
                                  (args (fargs expr)) ;move some of this stuff down?
                                  (arity (len args))
                                  (formals (fn-formals fn (w state))) ;;fixme: make use of the actual parameters somehow? maybe to help with type info?
                                  (exit-test-expr (second is-a-nice-tail-function-result))
                                  (base-case-expr (third is-a-nice-tail-function-result))
                                  (update-expr-list (fourth is-a-nice-tail-function-result)))
                             (declare (ignore dummy))
                             (b* ((- (cw "(~x0 is a nice tail rec. fn.)~%" fn))
                                  (- (cw "(Unroll is ~x0.)~%" unroll)))
                               ;; Try to completely unroll the function (if instructed too):
                               (mv-let
                                 (unrolled-result analyzed-function-table state)
                                 (if (or (eq :all unroll)
                                         (member-eq fn unroll)) ;or should there be an :unroll item in extra-stuff?
                                     (try-to-completely-unroll fn real-rep-counts test-cases analyzed-function-table extra-stuff state)
                                   (mv :failed analyzed-function-table state))
                                 (if (consp unrolled-result) ;tests for (list new-runes new-fns)
                                     (prog2$ (cw "Unrolled ~x0.)~%" fn)
                                             (mv nil unrolled-result analyzed-function-table rand state))
;move this check up?
                                   (if (all-equal$ 0 real-rep-counts) ;use all-eql$?
                                       ;;the function always exits immediately, so presumably its exit test is always true
                                       ;;but that expression is not exposed to mitering, and maybe it can't be proved during back-chaining,
                                       ;;so expand the function one more time and hide the recursive call from analysis (by renaming it and marking that function as analyzed)
;fixme do we still need this stuff, now that the rewriter can work-hard on a hyp? well, do we want to work-hard on the termination test every time we see a function call?
                                       (progn$ (cw "Not proving any inductive lemmas because the function seems to always just return.~%")
                                               (cw "(Opening one more step:~%")
                                               (mv-let (result analyzed-function-table state)
;fixme is this really an "action?
                                                 (open-one-more-step fn analyzed-function-table state)
                                                 (prog2$ (cw "Done opening one more step.))")
                                                         (mv nil result analyzed-function-table rand state))))



;done early so as not to interrupt the huge let below. fixme move down, since this can print stuff, and it's confusing

                                     (b* (((mv erp tail-rec-producer-result state) ;;  result is nil (if it's not a producer) or (list produced-formal dag-for-value-added-to-end)
                                           (tail-rec-producer fn interpreted-function-alist state) ;fixme destroys 'dag-array!
                                           )
                                          ((when erp) (mv erp :error nil rand state))
                                          ;;The usual case (detect and prove inductive properties about the function):
                                          ;;fixme I would like it if Axe only put in invars that can be established as preconditions to the functions, but not all supporting functions will necessarily by analyzed at this point (e.g., if we are analyzing foo, it may be supported by new-bar, introduced by transforming bar, or by baz, which represents a loop inside bar, which has been completely unrolled. i suppose we might nee mitering to establish preconditions without timing out?  but handling rec fns early (e.g., during pre-simp) seems to have advantages, because you can handle a lot of them on the same test cases.  maybe what happens is that they get unrolled.  maybe we should have a pre-unrolling phase.  also, what if properties are only true because of non-analyzed rec fns in the context of the node?

                                          (- (cw "(Not doing complete unrolling for ~x0.)~%" fn))
                                          (extra-invars (g :extra-hyps extra-stuff-for-fn)) ;rename extra-invars?
                                          (remove-invars (g :remove-hyps extra-stuff-for-fn)) ;rename this to hyps-to-remove or invars-to-remove (also the keyword in all examples)
                                          (extra-explanations (g :explanations extra-stuff-for-fn)) ;fixme change the keyword used in all examples to :extra-explanations
                                          (explanations-to-remove (g :explanations-to-remove extra-stuff-for-fn))

;do this for all annotations:
;(- (and extra-explanations
;            (cw "user-supplied explanations: ~x0.~%" extra-explanations)))

                                          ;;Check the syntactic forms of the user-supplied annotations: (may throw an error):
                                          (- (check-annotations fn extra-invars remove-invars extra-explanations explanations-to-remove formals))

                                          ;; Handle "old" variables:
                                          (old-vars (make-old-var-names formals)) ;avoids clashes; in sync with the formals
                                          ;;pairs the old-vars with their non-old formals:
                                          (old-var-to-formal-alist (pairlis$ old-vars formals))
                                          (- (cw "(old-var-to-formal-alist: ~x0)~%" old-var-to-formal-alist))
                                          (formal-to-old-var-alist (pairlis$ formals old-vars))

                                          ;;get rid of the calls to oldval in user-supplied stuff:
                                          (oldval-replacement-alist (pairlis$ (wrap-all 'oldval formals) old-vars))
                                          (extra-invars (replace-in-terms2 extra-invars oldval-replacement-alist))
                                          (remove-invars (replace-in-terms2 remove-invars oldval-replacement-alist))
                                          (extra-explanations (replace-in-terms2 extra-explanations oldval-replacement-alist))
                                          (explanations-to-remove (replace-in-terms2 explanations-to-remove oldval-replacement-alist))
                                          ;; (All calls to oldval should now be gone.)

                                          (args-traces (g-list-list :args traces)) ;yuck?  what else is there but the rvs?  uninteresting for tail rec fns

                                          (user-supplied-formulas-to-check (append extra-invars extra-explanations))
                                          ;;Check that the user-supplied invars and explanations hold on all the traces:
                                          (- (and user-supplied-formulas-to-check
                                                  (progn$ (cw "(Checking ~x0 user-supplied invariants: " (len user-supplied-formulas-to-check))
                                                          (if (invars-work-on-tracesp user-supplied-formulas-to-check
                                                                                      args-traces formals interpreted-function-alist old-var-to-formal-alist)
                                                              t
                                                            (hard-error 'analyze-rec-fn
                                                                        "Some user supplied invariant failed to hold!  See above."
                                                                        nil))
                                                          (cw "Done checking user-supplied invariants.)~%"))))

                                          ;;all the action for a tail-rec fn is in the parameters (not the return values, which are all the same)
                                          (individual-arg-traces (get-nths-from-traces arity args-traces))
                                          (formal-traces-alist (pairlis$ formals individual-arg-traces))
                                          (items-to-print (g :print-traces extra-stuff-for-fn))
                                          (- (print-traces items-to-print formal-traces-alist))

                                          (- (cw "(Finding unchanged components:~%"))
                                          (probably-unchanged-components (find-unchanged-components args-traces arity formals))
                                          (- (cw "Probably unchanged components: ~x0)~%" probably-unchanged-components))


                                          (- (cw "(formal-shape-alist: "))
                                          (formal-shape-alist (make-formal-shape-alist formals formal-traces-alist))
                                          (- (cw "~x0)~%" formal-shape-alist))

                                          (terms-unchanged-per-trace-alist (pair-terms-with-constants-list formals individual-arg-traces))
                                          (- (cw "(Terms unchanged per trace: ~x0)~%" (strip-cars terms-unchanged-per-trace-alist)))

                                          (- (cw "(Invariants:~%"))
                                          (found-invars (try-to-find-invars-for-term-lst formals individual-arg-traces nil formal-to-old-var-alist terms-unchanged-per-trace-alist))
                                          (- (cw "~x0)~%" found-invars))

                                          (- (cw "(Type facts about old-vals:~%"))
                                          (type-facts-about-old-vals
                                           (try-to-find-type-facts-about-old-vals-lst
                                            (map-strip-cars individual-arg-traces) ;hope each trace has at least one element..
                                            old-vars
                                            nil))
                                          (- (cw "~x0)~%" type-facts-about-old-vals))


                                          ;; (- (cw "(Bound invars:~%"))
                                          ;; ;;is this stuff better than the try-to-express-target-tree functions?
                                          ;; (other-invars (try-to-find-bound-hyps-for-terms formals individual-arg-traces formal-traces-alist formal-to-old-var-alist))
                                          ;; (- (cw "~x0)~%" other-invars))

                                          ;; Find probably-unchanged components:
;fixme what about unchanged lengths?
                                          (- (cw "(Finding constant components:~%"))
                                          (probably-constant-components (find-probably-constant-components probably-unchanged-components args-traces formals nil))
                                          (- (cw "Probably constant components: ~x0)~%" probably-constant-components))
                                          ;;We add an invariant for each unchanged component, mentioning the appropriate old-var :
                                          ;;fixme use these to simplify the other invars! careful! what if some of these end up not true?
                                          ;;dont waste time doing any other analysis regarding unchanged vars

                                          (unchanged-var-invars (make-unchanged-var-invars probably-unchanged-components formal-to-old-var-alist))

                                          ;; EXPLANATIONS: Try to explain components of the formals with other components (if explanations are found, the explained components are "redundant" and can be dropped):
                                          ;;this processes components of tuples and could look at the length invars generated above?  perhaps we should generate a shape for formals, ex: (:tuple int int (:list bv32) (:tuple int int int)) -- (do we do that now below?)
                                          ;;fffixme user-supplied-explanations should be tested out on the traces! (unless they have already been found by axe)
;fixme user user-supplied explanations to initialize the explanation-graph

                                          ;;Try to explain any formal (including subcomponents) in terms of others:
                                          ;;ffixme don't analyze terms for which the user has supplied explanations (at least ones that turned out to be true??):
                                          ;;quick and dirty (fixme use more than just the name).
                                          ;;fixme print a message?
                                          ;; (dont-explain-first-termp nil
                                          ;;                           ;(if (eq 'numcdrs (first formals)) tnil)
                                          ;;                           )

                                          (- (cw "(Detecting explanations of args with other args:~%"))
                                          ;;fffixme could use a more efficient analysis for unchanged values...
                                          (result (try-to-explain-terms2 formal-traces-alist nil ;formals-not-to-try-to-explain
                                                                         formal-to-old-var-alist probably-unchanged-components))
                                          (component-explanations (first result))
                                          (explanation-graph (second result))
                                          (- (cw "Explanations of args with other args:~%~x0)~%" component-explanations))

                                          (- (cw "(Detecting explanations of lengths:~%"))
                                          ;;note that lengths of components are not droppable items like components themselves are.
                                          ;;ffixme what if the user passes in length explanations - check for that?  they should be passed in as normal invars?
                                          (length-explanations-result (try-to-explain-lengths formal-traces-alist ;the terms are nth nests around formals?
                                                                                              explanation-graph formal-to-old-var-alist probably-unchanged-components))
                                          (length-explanations (first length-explanations-result))
                                          (explanation-graph (second length-explanations-result))
                                          (- (cw "Explanations of lengths:~%~x0)~%" length-explanations))

                                          (all-component-explanations (set-difference-equal ;fixme print a msg if this removes anything
                                                                       (union-equal extra-explanations component-explanations)
                                                                       explanations-to-remove)) ;fixme what if the user removes a length explan?
                                          (- (cw "(Component explanations after addition and removal according to user annotations:~%~x0)~%" all-component-explanations))

                                          ;;don't drop things explained in terms of the accumlator of a producer:
                                          (producer-accumulator-formal (if tail-rec-producer-result (first tail-rec-producer-result) nil))
                                          (components-explained-in-terms-of-producer-accumulator-formal
                                           (and producer-accumulator-formal
                                                (lhses-whose-rhses-mention producer-accumulator-formal all-component-explanations nil)
                                                ))

                                          (- (and components-explained-in-terms-of-producer-accumulator-formal
                                                  (cw "(Refraining from dropping these components that would be explained in terms of the accumulator of a producer (would cause the resulting function to use the accumulator in bad ways, breaking the producer pattern): ~x0)~%"
                                                      components-explained-in-terms-of-producer-accumulator-formal)))
                                          ((mv erp consumer-numcdrs-formals state)
                                           (consumer-numcdrs-parameters fn interpreted-function-alist state))
                                          ((when erp) (mv erp :error nil rand state))

                                          ;;abstain from special treatment here for any numcdrs-parameters that are not initialized to 0:
                                          (formals-args-alist (pairlis$ formals args)) ;pairs formals with the values passed in for them
;fixme what if the value passed in is 0 but not a quoted zero?  won't happen for numcdrs params?
                                          (formals-initialized-to-zero (keep-keys-paired-with-quoted-zero formals-args-alist dag-array-name dag-array))
                                          (numcdrs-formals-not-to-try-to-drop (intersection-eq consumer-numcdrs-formals formals-initialized-to-zero))
                                          (- (and numcdrs-formals-not-to-try-to-drop
                                                  (cw "(Refraining from dropping these formals that appear to be numcdrs formals from a producer: ~x0)~%"
                                                      numcdrs-formals-not-to-try-to-drop)))

                                          ;;saw a loop where we drop an unchanged formal (in the process making a formal for the old val that explains the dropped formal, but this new formal is it self unchanged and gets dropped in the same way and so on forever)
                                          ;;would be okay if the unchanged component is explained without the use of old vals (or with old vals that will have to be made into real params anyway)?
                                          ;;fixme, new policy: we now don't generate an explanation for a component in terms of just an old var.
                                          (components-not-to-try-to-drop (append components-explained-in-terms-of-producer-accumulator-formal
                                                                                 numcdrs-formals-not-to-try-to-drop))
                                          (all-component-explanations-for-dropping (remove-equalities-with-lhses all-component-explanations components-not-to-try-to-drop))
                                          (- (cw "(Component explanations to use for dropping:~%~x0)~%" all-component-explanations-for-dropping))
                                          (invars (append found-invars
                                                          length-explanations
                                                          all-component-explanations
                                                          unchanged-var-invars ;new!
;fixme if any of these are about old-vars that are not otherwise needed, drop them (or don't generate them in the first place?)
                                                          type-facts-about-old-vals))

                                          ;; Add and remove invars as specified manually by the user:
                                          (invars (if extra-invars
                                                      (prog2$ (cw "(Using user-supplied invars: ~x0.)~%" extra-invars)
                                                              (append invars extra-invars)) ;reverse args to append?
                                                    invars))
                                          (invars (if remove-invars
                                                      (prog2$ (cw ",,Removing invars (as requested by the user): ~x0.~%" remove-invars)
                                                              (set-difference-equal invars remove-invars))
                                                    invars))

                                          ;;filter the invars somehow? e.g., to take out ones implied by others? orient the invars? can't do that yet since the stronger ones may fail to prove
                                          ;;what about invars that are syntactically different but equivalent?
                                          (invars (remove-duplicates-equal invars))
                                          (- (cw "(Candidate invariants (~x0 total): ~X12)~%" (len invars) invars nil))
                                          (formal-update-expr-alist (pairlis$ formals update-expr-list))
                                          (negated-exit-test `(equal ,exit-test-expr 'nil)) ;fixme use not?
                                          ;; fixme we used to only use the first 1008 of these (there may be 1000s of cases, one for each recursive call of the surrounding function).
                                          ;; now trying to use them all. if that is too much, just don't generate them all (but choose an interesting subset - don't let most of them come ffrom one trace?)
;ffixme don't bother storing values for formals or old-vals that are not used in the candidate invariants; that's all this is used for
                                          ;;throws away the last sample of each trace:
                                          (test-cases-for-formals-and-old-vars (make-test-cases-for-formals-and-old-vars formals old-var-to-formal-alist args-traces))
                                          ((mv erp proved-invars updates-preserve-invars-rule-symbols rand state)
                                           ;;fixme first consider only invars relevant to the droppers (by looking at what vars are mentioned, how they are updated, and what invars they appear in)?
                                           (find-maximal-inductive-set-of-invars invars
                                                                                 (pack$ fn '-invariant-set-)
                                                                                 formal-update-expr-alist
                                                                                 (list negated-exit-test) ;fixme expand this?!
                                                                                 0 rewriter-rule-alist prover-rule-alist
                                                                                 extra-stuff interpreted-function-alist
                                                                                 test-cases-for-formals-and-old-vars
                                                                                 miter-depth-to-use unroll monitored-symbols print max-conflicts options rand state))
                                          ((when erp) (mv erp :error nil rand state))
                                          (proved-dropping-invars (intersection-equal all-component-explanations-for-dropping proved-invars))
                                          ;; If we can drop any params we do it now (and then peel off the base case):
                                          ((mv erp drop-result drop-runes drop-fns new-fn analyzed-function-table state)
                                           (if (or (not proved-dropping-invars)
                                                   ;;fixme if this is the case, don't even look for explans? or maybe we still want them?
                                                   (if (g :do-not-drop (g :options extra-stuff))
                                                       (prog2$ (cw "(:do-not-drop is specified.)") t)
                                                     nil))
                                               (mv nil :failed nil nil nil analyzed-function-table state)
                                             ;; Attempt dropping:
                                             ;; (The dropping process includes proving the invariant, because we might need it to prove some of the discovered explanations of params).
                                             (drop-params-from-tail-function fn
                                                                             proved-dropping-invars ; could the possible by improved if called improve-invars?
                                                                             updates-preserve-invars-rule-symbols
                                                                             proved-invars
                                                                             update-expr-list
                                                                             formal-update-expr-alist
                                                                             exit-test-expr
                                                                             negated-exit-test
                                                                             base-case-expr
                                                                             formal-shape-alist
                                                                             old-vars
                                                                             old-var-to-formal-alist
; rewriter-rule-alist
                                                                             prover-rule-alist
;extra-stuff
                                                                             interpreted-function-alist
                                                                             formals
                                                                             analyzed-function-table
;unroll monitored-symbols print max-conflicts
                                                                             state)))
                                          ((when erp) (mv erp :error analyzed-function-table rand state)))

                                       (if (eq :error drop-result)
                                           (prog2$ (cw "FAIL in dropping")
                                                   (mv t :error analyzed-function-table rand state))
                                         (if (eq :success drop-result)
                                             ;;Dropping worked.  Now possibly peel off the base case.
                                             (if (not (need-to-peel-off-base-casep new-fn state))
                                                 (prog2$
                                                  (cw "done with rec fn.)~%")
                                                  (mv nil (list drop-runes drop-fns) analyzed-function-table rand state))
                                               (prog2$ (cw "(Peeling off base case of -new function: ~x0.~%" new-fn)
                                                       (mv-let (erp peel-result analyzed-function-table state)
                                                         (peel-off-base-case-of-tail-fn new-fn
                                                                                        interpreted-function-alist ;fixme does this need to include new-fn?
                                                                                        analyzed-function-table state)
                                                         (if erp
                                                             (mv erp :error analyzed-function-table rand state)
                                                           (if (not (consp peel-result)) ;tests for error or failure
                                                               (prog2$ (cw "FAIL in peeling) done with rec. fn.)~%")
                                                                       (mv nil
                                                                           (list drop-runes drop-fns)
                                                                           analyzed-function-table rand state))
                                                             ;;fixme we could combine the dropping and peeling rules into one rule that does both..
                                                             (prog2$ (cw "done peeling.) done with rec. fn.)~%")
                                                                     (mv nil
                                                                         (list (append drop-runes (first peel-result))
                                                                               (append drop-fns (second peel-result)))
                                                                         analyzed-function-table rand state)))))))
                                           ;; Dropping failed (no redundant params to drop, or we couldn't prove any):
                                           (prog2$
                                            (cw "(Not dropping any components.)~%")
                                            (mv-let (erp
                                                     new-runes unchanged-runes ;don't separate these two?
                                                     new-fns analyzed-function-table rand state)
                                              (prove-theorems-about-tail-function
                                               fn
                                               proved-invars ;over the formals and OLD-VARS
                                               updates-preserve-invars-rule-symbols
                                               (intersection-equal proved-invars unchanged-var-invars)
                                               old-vars
                                               old-var-to-formal-alist
                                               probably-unchanged-components
                                               explanation-graph
                                               exit-test-expr
                                               base-case-expr
                                               update-expr-list
                                               oldval-replacement-alist
                                               formal-shape-alist
;rewriter-rule-alist
                                               prover-rule-alist extra-stuff interpreted-function-alist
                                               args-traces ;values for the old vars are implicit in this
;unroll
                                               analyzed-function-table
;monitored-symbols
                                               max-conflicts print rand state)
                                              (if erp
                                                  (prog2$ (cw ")")
                                                          (mv t :error analyzed-function-table rand state))
                                                (prog2$ (cw "Proved theorem about ~x0.~%)~%" fn)
                                                        (mv nil
                                                            (list (append unchanged-runes new-runes)
                                                                  new-fns)
                                                            analyzed-function-table
                                                            rand state))
                                                ;;                                            (state (if in-axe-proverp ;ffffffixme this seems bad..
                                                ;; ;i guess we can't pass the theorems between calls to the prover (if used in a clause processor, but we don't want to analyze the same function twice in the same call to the prover...
                                                ;;                                                       state ;could record the theorem so we don't have to rediscover it..
                                                ;;                                                     (f-put-global
                                                ;;                                                      'rec-fn-lemma-and-fn-table
                                                ;;                                                      (s fn
                                                ;;                                                         (list (append unchanged-runes new-runes)
                                                ;;                                                               nil)
                                                ;;                                                         rec-fn-lemma-and-fn-table)
                                                ;;                                                      state)))
                                                ))))))))))))))))))))))))
 ;;ffixme improve what we do here to have all the fancy things we do for nice tail rec fns
 ;; (let ((args-traces (g-list-list :args traces))
 ;;                                      (return-value-traces (g-list-list :return-value traces))
 ;; ;ffixme what about values for the old vars?
 ;;                                      (test-cases-for-formals (make-test-cases-for-formals formals args-traces))
 ;;                                      (function-call-term `(,fn ,@formals))
 ;;                                      ;;(function-call-term-with-hide `(hide ,function-call-term))
 ;;                                      ;;We try to express the return value as a simple expression over the params.
 ;;                                      (possible-rv-equalities (try-to-express-rv-with-params return-value-traces args-traces
 ;;                                                                                             :var ;;function-call-term ;;-with-hide
 ;;                                                                                             arity formals))
 ;;                                      (dummy100 (if (not possible-rv-equalities)
 ;;                                                    ;;used to be an error:
 ;;                                                    (cw "!! analyze-rec-fn could find no pattern for the call: ~x0.~%" expr)
 ;;                                                  nil))
 ;;                                      (theorem-name (if make-type-factsp
 ;;                                                        (pack$ fn '-generated-theorem-with-type-facts)
 ;;                                                      (pack$ fn '-generated-theorem)))
 ;;                                      (hyps (try-to-find-hyps args-traces arity formals fn))
 ;;                                      (dummy (cw ",,Hyps (~x0 total): ~x1" (len hyps) hyps))
 ;;                                      ;;ffixme what about components that support these components?
 ;;                                      ;;fixme put this filtering back in?
 ;;                                      ;;                       (mentioned-arg-components
 ;;                                      ;;                        (get-mentioned-arg-components (strip-caddrs possible-rv-equalities) arity 'arg)
 ;;                                      ;;                        )
 ;;                                      ;;fixme wasteful to generate all the hyps and than throw many of them away
 ;;                                      (hyps hyps ;(keep-hyps-about-components hyps mentioned-arg-components arity 'arg)
 ;;                                            )
 ;;                                      (hyps (refine-hyps fn hyps extra-stuff formals))
 ;; ;ffixme copy the hyp processing above?
 ;;                                      (rv-type-facts (if make-type-factsp
 ;;                                                         (make-type-facts-for-rv return-value-traces :var ;;function-call-term ;;-with-hide
 ;;                                                                                 )
 ;;                                                       nil))
 ;; ;fffixme print the type facts!
 ;;                                      (concs (append (get-extra-concs fn extra-stuff) rv-type-facts possible-rv-equalities)))
 ;;                                 (declare (ignore dummy dummy100 dummy101))
 ;;                                 (mv-let
 ;;                                  (is-a-head-aux-function update-fn)
 ;;                                  ;;fffixme if it's a head-aux function we don't really need the hyps??
 ;;                                  (is-a-head-aux-function fn state)
 ;;                                  (let* ((hide-opener-name (pack$ fn '-hide-opener))
 ;;                                         (hide-dropper-name (pack$ fn '-hide-dropper))
 ;;                                         (state (make-hide-opener-and-dropper fn formals (or is-a-head-aux-function use-axe-proverp)
 ;;                                                                              hide-opener-name hide-dropper-name state)))
 ;; ;ffixme consider doing the inductive step as a separate theorem, so i have more control over it
 ;; ;(try each conjunct in turn?)
 ;; ;axe-prover here should find probably-equal nodes...
 ;;                                    (mv-let (erp state)
 ;;                                            (if is-a-head-aux-function
 ;; ;in this case, we don't need the hyps?  or the hide-opener and hide-dropper?
 ;;                                                (prove-theorem-about-head-aux-function theorem-name fn ;hyps
 ;;                                                                                       concs update-fn ;function-call-term
 ;;                                                                                       prover-rule-alist interpreted-function-alist
 ;;                                                                                       state)
 ;;                                              (my-defthm-fn-rewrite-with-and-without-hides
 ;;                                               (list function-call-term)
 ;;                                               theorem-name
 ;;                                               hyps
 ;;                                               (sublis-var-simple-lst (acons :var function-call-term nil) concs)
 ;;                                               `(("goal" :induct ,function-call-term
 ;;                                                  :in-theory (union-theories (theory 'minimal-theory)
 ;;                                                                             '((:induction ,fn)))
 ;;                                                  :do-not '(generalize eliminate-destructors))
 ;;                                                 ,@(if use-axe-proverp
 ;;                                                       `((if STABLE-UNDER-SIMPLIFICATIONP
 ;;                                                             '(:clause-processor
 ;;                                                               (axe-prover
 ;;                                                                clause
 ;;                                                                ',(s :goal-name theorem-name (axe-prover-hints
 ;;                                                                                              `(,hide-opener-name
 ;;                                                                                                ,hide-dropper-name)
 ;;                                                                                              prover-rule-alist
 ;;                                                                                              interpreted-function-alist
 ;;                                                                                              (firstn 200 test-cases-for-formals) ;ffixme why not all traces?
 ;;                                                                                              analyzed-function-table))
 ;;                                                                state)
 ;;                                                               :do-not '(generalize eliminate-destructors))
 ;;                                                           nil))
 ;;                                                     nil))
 ;;                                               ;;should we open up axe-evaluator here?
 ;;                                               ;;what if we need to do proofs about terms?
 ;;                                               state))
 ;;                                            (if erp
 ;;                                                (prog2$ (hard-error 'analyze-rec-fn
 ;;                                                                    "failed to prove the theorem" nil)
 ;;                                                        (prog2$ (cw ")")
 ;;                                                                (mv :error extra-stuff analyzed-function-table state)))
 ;;                                              (let ( ;; (state
 ;;                                                    ;;                                         (if in-axe-proverp ;fffixme
 ;;                                                    ;;                                             state
 ;;                                                    ;;                                           (f-put-global 'rec-fn-lemma-and-fn-table
 ;;                                                    ;;                                                         (s fn
 ;;                                                    ;;                                                            (list `(,theorem-name)
 ;;                                                    ;;                                                                  nil)
 ;;                                                    ;;                                                            rec-fn-lemma-and-fn-table)
 ;;                                                    ;;                                                         state)))
 ;;                                                    )
 ;;                                                (prog2$ (cw ")")
 ;;                                                        ;;introducing one new rule and no fns:
 ;;                                                        (mv (list `(,theorem-name) nil)
 ;;                                                            extra-stuff
 ;;                                                            (s fn (s :proved-lemma-about-non-nice-tail-fn t nil) analyzed-function-table)
 ;;                                                            state)))))))
 ;;                                 )

 ;;get rid of this wrapper? have analyze-rec-fn throw an error?
 ;;returns (mv erp result analyzed-function-table rand state) where, if ERP is nil, then RESULT is :failed or (list new-runes new-fns).
 ;;speed things up by reusing traces between calls to this function! and then don't pass in the test-cases
 ;;TEST-CASE-ARRAY-ALIST can be nil?
 ;;i believe result will be (list nil nil) if we've already analyzed the function
 (defun analyze-rec-fn-wrapper (nodenum ; must be the nodenum of a non-built-in recursive function call
                                dag-array-name dag-array interpreted-function-alist extra-stuff
                                rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table unroll miter-depth-to-use monitored-symbols
                                max-conflicts print options rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (mv-let (erp result analyzed-function-table rand state)
     (analyze-rec-fn nodenum dag-array-name dag-array interpreted-function-alist
                     extra-stuff rewriter-rule-alist prover-rule-alist
                     test-cases ;these assign values to the inputs
                     ;;t          ;yes, make type facts
                     test-case-array-alist
                     analyzed-function-table
                     unroll miter-depth-to-use monitored-symbols max-conflicts print options
                     rand state)
     (if erp
         (mv erp nil analyzed-function-table rand state)
       (if (eq :error result)
           (mv (erp-t)
               (hard-error 'analyze-rec-fn-wrapper "unexpected failure" nil)
               analyzed-function-table rand state)
         ;;result is (list .. ..) or :failed :
         (mv (erp-nil) result analyzed-function-table rand state)))))

 ;; Returns (mv erp result analyzed-function-table rand state), where result is (list new-runes new-fns)
 ;;allow this to return :failed or :error?
 ;;ffixme check results for :error?
 ;;i believe result will be (list nil nil) is we've already analyzed all of the rec. functions
 ;;TEST-CASE-ARRAY-ALIST can be nil?
;if foo supports ba and we will be replacing foo (say, after dropping some params), i suppose we might want to do the replacement before analyzing bar (if we look at the syntax of the args coming in to bar)?
 ;; even if all this does if prove lemmas (no transformations), we should still rewritie using the generated runes, since they may express some rvs in closed form
 (defun analyze-rec-fns (nodenums ;;must all be nodenums of (non built-in) recursive function calls
                         dag-array-name dag-array interpreted-function-alist extra-stuff
                         rewriter-rule-alist prover-rule-alist ;fixme pass in a rule-alist instead?
                         test-cases test-case-array-alist analyzed-function-table unroll miter-depth-to-use monitored-symbols max-conflicts print options rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (if (endp nodenums)
       (mv nil nil analyzed-function-table rand state)
     (mv-let (erp car-result analyzed-function-table rand state)
       (analyze-rec-fn-wrapper (first nodenums) dag-array-name dag-array interpreted-function-alist extra-stuff
                               rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table unroll miter-depth-to-use monitored-symbols max-conflicts print options rand state)
       (if erp
           (mv erp nil analyzed-function-table rand state)
         (mv-let (erp cdr-result analyzed-function-table rand state)
           (analyze-rec-fns (rest nodenums) dag-array-name dag-array interpreted-function-alist
                            extra-stuff rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table unroll miter-depth-to-use monitored-symbols
                            max-conflicts print options rand state)
           (if erp
               (mv erp nil analyzed-function-table rand state)
             (mv nil
                 (if (eq :failed car-result)
                     cdr-result
                   (list (append (first car-result) (first cdr-result))
                         (append (second car-result) (second cdr-result))))
                 analyzed-function-table
                 rand state)))))))

 ;;  ;;returns (mv provedp state), where if PROVEDP is non-nil, then DEFTHM-NAME (which proves that HYPS impy CONJUNCT) has been proved in STATE
 ;;  ;;crud the hyps need to be simplified (the not exit hyp for the unrolled function is huge...)
 ;;  ;; could simplify that when we make the unrolled function... (an unrolled function's body may also take a lot of work to simplify!)
 ;;  ;;ffixme should this return the analyzed-function table and other stuff?
 ;; ;fixme perhaps we should simplify the updates earlier than here - once we get here, the updates may be mentioned multiple times in the connection conjuncts
 ;; ;except for the printing we could just call prove-theorem
 ;; ;eliminate this wrapper?
 ;;  (defun prove-connection-conjunct (conjunct ;a term
 ;;                                    hyps ;terms over the formals of both functions
 ;;                                    defthm-name current-conjunct-num conjunct-count
 ;;                                    rewriter-rule-alist prover-rule-alist
 ;;                                    extra-stuff interpreted-function-alist
 ;;                                    test-cases-for-formals-and-old-vars
 ;;                                    miter-depth-to-use
 ;;                                    print monitored-symbols
 ;;                                    analyzed-function-table
 ;;                                    unroll max-conflicts
 ;;                                    state)
 ;;    (declare (xargs :mode :program :stobjs state))
 ;;    (let* ((dummy (progn$ (cw "(Proving connection conjunct ~x0 of ~x1:~%~x2.~%" current-conjunct-num conjunct-count conjunct)
 ;;                          (cw "(Extra stuff: ~x0)~%" extra-stuff)
 ;; ;                          (cw "(rewriter-rule-alist:~%")
 ;;                          ;;                          (print-list (rule-name-list rewriter-rules)) ;don't print all this?
 ;; ;                         (cw ")~%")
 ;;                          (cw "(monitored-symbols: ~x0)~%" monitored-symbols)
 ;;                          (cw "(Hyps: ~x0.)~%" hyps)))) ;ffixme for sha1 the one of the hyps is a not of a big boolor nest - convert to a bvand nest?
 ;;      (declare (ignore dummy))
 ;;      (mv-let (provedp state)
 ;;              (prove-theorem conjunct
 ;;                             hyps
 ;;                             nil ;Thu Feb 17 18:20:18 2011 ; hyps ;fixme cut this down - most hyps should not fail
 ;;                             defthm-name
 ;;                             rewriter-rule-alist
 ;;                             prover-rule-alist
 ;;                             extra-stuff interpreted-function-alist
 ;;                             test-cases-for-formals-and-old-vars
 ;;                             miter-depth-to-use
 ;;                             print
 ;;                             (cons 'equal-of-map-packbv-and-map-packbv monitored-symbols) ;fixme
 ;;                             analyzed-function-table
 ;;                             unroll
 ;;                             t ;make the theorem
 ;;                             max-conflicts
 ;;                             state)
 ;;              (if provedp
 ;;                  (prog2$ (cw "Proved connection conjunct ~x0 of ~x1.)~%" current-conjunct-num conjunct-count)
 ;;                          (mv t state))
 ;;                (prog2$ (cw "FAILed to prove connection conjunct ~x0 of ~x1.)~%" current-conjunct-num conjunct-count) ;should this be an error?
 ;;                        (mv nil state))))))

 ;;  ;;make this more general purpose?
 ;;  ;;pull out the notion of using a miter (after simplifying it) to prove a theorem?
 ;;  ;;returns (mv defthm-names state)
 ;;  (defun prove-connection-conjuncts-aux (conjuncts ;these are terms
 ;;                                         current-conjunct-num conjunct-count
 ;;                                         hyps ;fixme split into hyps that can fail and hyps that can't?
 ;;                                         base-name ; formal-update-expr-alist assumptions invar-set-num invar-num
 ;;                                         rewriter-rule-alist
 ;;                                         prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                         test-cases-for-formals-and-old-vars
 ;;                                         miter-depth-to-use
 ;;                                         defthm-name-acc print monitored-symbols
 ;;                                         analyzed-function-table
 ;;                                         unroll max-conflicts
 ;;                                         state)
 ;;    (declare (xargs :mode :program :stobjs state))
 ;;    (if (endp conjuncts)
 ;;        (mv defthm-name-acc state)
 ;;      (let ((defthm-name (pack$ base-name current-conjunct-num))
 ;;            (conjunct (first conjuncts)))
 ;;        (mv-let (provedp state)
 ;;                (prove-connection-conjunct conjunct hyps defthm-name current-conjunct-num conjunct-count rewriter-rule-alist
 ;;                                           prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                           test-cases-for-formals-and-old-vars
 ;;                                           miter-depth-to-use
 ;;                                           print monitored-symbols
 ;;                                           analyzed-function-table
 ;;                                           unroll max-conflicts
 ;;                                           state)
 ;;                (if (not provedp)
 ;;                    (mv (hard-error 'prove-connection-conjuncts-aux "Failed to prove conjunct: ~x0.~%" (acons #\0 (car conjuncts) nil))
 ;;                        state)
 ;;                  (prove-connection-conjuncts-aux (rest conjuncts)
 ;;                                                  (+ 1 current-conjunct-num) conjunct-count
 ;;                                                  hyps
 ;;                                                  base-name rewriter-rule-alist
 ;;                                                  prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                                  test-cases-for-formals-and-old-vars
 ;;                                                  ;;(+ 1 conjunct-num)
 ;;                                                  miter-depth-to-use
 ;;                                                  (cons defthm-name defthm-name-acc) print monitored-symbols
 ;;                                                  analyzed-function-table
 ;;                                                  unroll max-conflicts
 ;;                                                  state))))))

 ;;  ;;returns (mv defthm-names state) ;what about failures?
 ;;  (defun prove-connection-conjuncts (conjuncts ;these are terms
 ;;                                     hyps
 ;;                                     base-name
 ;;                                     rewriter-rule-alist
 ;;                                     prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                     test-cases-for-formals-and-old-vars
 ;;                                     miter-depth-to-use
 ;;                                     defthm-name-acc print monitored-symbols
 ;;                                     analyzed-function-table
 ;;                                     unroll max-conflicts
 ;;                                     state)
 ;;    (declare (xargs :mode :program
 ;;                    :stobjs state))
 ;;    ;;first try to prove all of the conjuncts simultaneously:
 ;;    (let ((defthm-name (pack$ base-name '-all))
 ;;          (conjunction (make-conjunction-from-list conjuncts)))
 ;;      (mv-let (provedp state)
 ;;              (prove-connection-conjunct conjunction ;the whole thing
 ;;                                         hyps
 ;;                                         defthm-name
 ;;                                         1 ;;current-conjunct-num ;;ffixme use "only" but it expects an integer?
 ;;                                         1 ;;conjunct-count ;;ffixme use "all" but it expects an integer?
 ;;                                         rewriter-rule-alist
 ;;                                         prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                         test-cases-for-formals-and-old-vars
 ;;                                         miter-depth-to-use
 ;;                                         print monitored-symbols
 ;;                                         analyzed-function-table
 ;;                                         unroll max-conflicts
 ;;                                         state)
 ;;              (if provedp
 ;;                  (mv (list defthm-name) state)
 ;;                (prog2$ (cw "FAILed to prove them all together - fffixme should this ever happen??~%")
 ;;                        ;;ffixme if we can't prove them all together, what does that mean?
 ;;                        ;;ffffixme find the maximal provable subset?
 ;;                        (prove-connection-conjuncts-aux conjuncts
 ;;                                                        1 ;;current-conjunct-num
 ;;                                                        (len conjuncts) ;;conjunct-count
 ;;                                                        hyps
 ;;                                                        base-name
 ;;                                                        rewriter-rule-alist
 ;;                                                        prover-rule-alist extra-stuff interpreted-function-alist
 ;;                                                        test-cases-for-formals-and-old-vars
 ;;                                                        ;;0 ;conjunct-num
 ;;                                                        miter-depth-to-use
 ;;                                                        defthm-name-acc print monitored-symbols
 ;;                                                        analyzed-function-table
 ;;                                                        unroll max-conflicts
 ;;                                                        state))))))

 ;;       (mv-let (failedp state)
 ;;               ;call miter and merge here, or something?
 ;;               (my-defthm defthm-name
 ;;                          hyps
 ;;                          (list (car conjuncts)) ;would like to save the cons here
 ;;                          :rule-classes nil
 ;;                          :hints `(("Goal" :in-theory (union-theories (theory 'minimal-theory)
 ;;                                                                      '(,@enables))
 ;;                                    :do-not '(generalize eliminate-destructors))
 ;;                                   (if stable-under-simplificationp
 ;;                                       '(:clause-processor
 ;;                                         (axe-prover
 ;;                                          clause
 ;; ;can't refer to ID in a clause processor hint?
 ;; ;                                      (s ':id
 ;; ;                                        id
 ;;                                          ',(s :print t (axe-prover-hints
 ;;                                                         nil
 ;;                                                         prover-rule-alist interpreted-function-alist
 ;; ;fffixme does this not capture information from enough traces (what if most of the test cases come from 1 trace)?
 ;;                                                         (firstn 1020 test-cases-for-formals-and-old-vars) ;fixme there may be 1000s of cases (one for each recursive call of the surrounding function?)
 ;;                                                         ))
 ;; ;)
 ;;                                          state)
 ;;                                         :do-not '(generalize eliminate-destructors))
 ;;                                     nil)))

 ;; This relies on Axe already having proved invariants for the two functions (for each function, it needs the invar and the theorem that the updates preserve the invar).
 ;;   fffixme actually, i wonder whether we should not rely on the stored invariant about F when trying to connect F to G.  what if we split cases since we analyzed F and so know more?
 ;;returns (mv erp new-runes new-fn-names rand state) (the only new function is the connection predicate?)
 ;;ffixme if we don't use the rvs from the traces (since these are tail functions, they are all the same, don't bother adding them to the traces..)
 ;;fffixme this needs to take the argument terms of the functions in order to specialize the final theorem?
 ;;also uses one helper lemma proved about each function???

 (defun generate-connection-lemma-for-nice-tail-rec-fns (fn1
                                                         exit-test-expr1
                                                         base-case-expr1
                                                         update-expr-list1 ;one for each formal of fn1
                                                         traces1
                                                         args1 ;nodenums and quoteps

                                                         fn2
                                                         exit-test-expr2
                                                         base-case-expr2
                                                         update-expr-list2 ;one for each formal of fn2
                                                         traces2
                                                         args2 ;nodenums and quoteps

                                                         max-conflicts
                                                         rewriter-rule-alist
                                                         prover-rule-alist
                                                         extra-stuff interpreted-function-alist
                                                         miter-depth-to-use ;the depth to use if this routine needs to build a miter
                                                         print monitored-symbols
                                                         analyzed-function-table
                                                         unroll options
                                                         rand state)
;figure out the connection relation between the params and show that the update functions preserve it, given the negations of the exit tests - perhaps also include the invariants??
;adapt the connection relation according to which components are actually returned...
   (declare (ignore args1 args2) ;fffixme!
            (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :mode :program :stobjs (rand state)))
   (let*
       ((dummy0 (cw "(Proving connection lemma for nice tail rec fns ~x0 (~x1 traces) and ~x2 (~x3 traces).~%"
                    fn1 (len traces1) fn2 (len traces2) ;(len rewriter-rules)
                    ))
        (original-formals1 (fn-formals fn1 (w state)))
        (original-formals2 (fn-formals fn2 (w state)))

        ;;ffixme we should guarantee (elsewhere) that the old-vars for a function are distinct from its formals.

        (fn1-analyzed-function-info (g-safe fn1 analyzed-function-table))
        (fn2-analyzed-function-info (g-safe fn2 analyzed-function-table))
;these are only for the old vars that appear in the invariant:
        (original-old-var-to-formal-alist1 (g :old-var-to-formal-alist fn1-analyzed-function-info)) ;fixme think about when this can be nil
        (original-old-var-to-formal-alist2 (g :old-var-to-formal-alist fn2-analyzed-function-info))
        (dummy1 (prog2$ (cw "old-var-to-formal-alist for ~x0: ~x1~%" fn1 original-old-var-to-formal-alist1)
                        (cw "old-var-to-formal-alist for ~x0: ~x1~%" fn2 original-old-var-to-formal-alist2)))

        ;;i suppose we could pass this around in analyzed-function-table??
        ;;         (old-var-alist-table (f-get-global 'old-var-alist-table state))
        ;;         (original-old-var-alist1 (lookup-eq-safe fn1 old-var-alist-table)) ;pairs "old" vars with their formals
        ;;         (original-old-var-alist2 (lookup-eq-safe fn2 old-var-alist-table))
        (original-old-vars1 (strip-cars original-old-var-to-formal-alist1))
        (original-old-vars2 (strip-cars original-old-var-to-formal-alist2))

        ;;ffixme we may have already done a lot of the analysis below when trying to simplify the rv of the fn...

        ;;we prepend 'f' and 'g' to the formals and old-vars of the two functions to prevent any name clashes between functions:
        (prefix-for-fn1 (if (symbol< fn1 fn2) 'f 'g)) ;new
        (prefix-for-fn2 (if (symbol< fn1 fn2) 'g 'f)) ;new
        (formals1 (mypackn-list (cons-onto-all prefix-for-fn1 (enlist-all original-formals1))))
        (formals2 (mypackn-list (cons-onto-all prefix-for-fn2 (enlist-all original-formals2))))

        (function-call-term1 `(,fn1 ,@formals1)) ;are these used other than in printing?
        (function-call-term2 `(,fn2 ,@formals2))
        (dummy2 (cw "Function call 1: ~x0~%" function-call-term1))
        (dummy3 (cw "Function call 2: ~x0~%" function-call-term2))

        (formal-renaming-alist1 (pairlis$ original-formals1 formals1))
        (formal-renaming-alist2 (pairlis$ original-formals2 formals2))

        (old-vars1 (mypackn-list (cons-onto-all prefix-for-fn1 (enlist-all original-old-vars1))))
        (old-vars2 (mypackn-list (cons-onto-all prefix-for-fn2 (enlist-all original-old-vars2))))
        (old-var-renaming-alist1 (pairlis$ original-old-vars1 old-vars1))
        (old-var-renaming-alist2 (pairlis$ original-old-vars2 old-vars2))

        (formal-and-old-var-renaming-alist1 (append formal-renaming-alist1 old-var-renaming-alist1))
        (formal-and-old-var-renaming-alist2 (append formal-renaming-alist2 old-var-renaming-alist2))

        ;;associates renamed old-vars with their renamed formals:
        (old-var-to-formal-alist1 (compose-alists (pairlis$ old-vars1 original-old-vars1)
                                                  (compose-alists original-old-var-to-formal-alist1 formal-renaming-alist1)))
        (old-var-to-formal-alist2 (compose-alists (pairlis$ old-vars2 original-old-vars2)
                                                  (compose-alists original-old-var-to-formal-alist2 formal-renaming-alist2)))
        (old-var-to-formal-alist (append old-var-to-formal-alist1 old-var-to-formal-alist2))
        (formal-to-old-var-alist (reverse-alist old-var-to-formal-alist)) ;gross?
        (dummy4 (cw "(formal to old var alist: ~x0.)~%" formal-to-old-var-alist))

        (exit-test-expr1 (sublis-var-simple formal-renaming-alist1 exit-test-expr1))
        (base-case-expr1 (sublis-var-simple formal-renaming-alist1 base-case-expr1))
        (update-expr-list1 (sublis-var-simple-lst formal-renaming-alist1 update-expr-list1))
        (exit-test-expr2 (sublis-var-simple formal-renaming-alist2 exit-test-expr2))
        (base-case-expr2 (sublis-var-simple formal-renaming-alist2 base-case-expr2))
        (update-expr-list2 (sublis-var-simple-lst formal-renaming-alist2 update-expr-list2))

        (arity1 (len formals1))
        (arity2 (len formals2))
        ;;ffixme we may have already done a lot of the analysis below when trying to simplify the rvs of the individual fns...

        (args-traces1 (g-list-list :args traces1)) ;each args-trace is a sequence of tuples (each tuple has a value for each param)??
        (args-traces2 (g-list-list :args traces2))
        (fn1-unchanged-components (g :unchanged-components fn1-analyzed-function-info))
        (fn1-unchanged-components (sublis-var-simple-lst formal-renaming-alist1 fn1-unchanged-components))
        (fn2-unchanged-components (g :unchanged-components fn2-analyzed-function-info))
        (fn2-unchanged-components (sublis-var-simple-lst formal-renaming-alist2 fn2-unchanged-components))
        (unchanged-components (append fn1-unchanged-components fn2-unchanged-components)) ;ffixme think about the use of unchanged components below..

        (explanation-graph1 (g :explanation-graph fn1-analyzed-function-info)) ;can be nil
        (explanation-graph2 (g :explanation-graph fn2-analyzed-function-info)) ;can be nil
        (explanation-graph1 (rename-explanation-graph formal-renaming-alist1 explanation-graph1))
        (explanation-graph2 (rename-explanation-graph formal-renaming-alist2 explanation-graph2))
        (explanation-graph (append explanation-graph1 explanation-graph2)) ;just combine the pairs of both graphs

        (dummy5a (cw "(Trying to find connections that explain values in ~x0:~%" fn1))
        ;;fffixme do these need to be directed?  if so, which direction should we go?
        ;;maybe we will be rewriting equalities of the two equated things...
        ;;fixme what if we can't express one thing in terms of the other but we do have a predicate that holds over them (e.g., prefixp?)
;fixme does this only need half the formal-to-old-var-alist (and likewise below?)
        (connections1-result (try-to-express-params-with-params args-traces1 arity1 formals1 args-traces2 arity2 formals2 formal-to-old-var-alist unchanged-components explanation-graph nil))
        (explanation-graph (first connections1-result)) ;print this?
        (connections1 (second connections1-result))

        (dummy5b (cw "Connections1: ~x0)~%" connections1))
        (dummy5c (cw "(Trying to find connections that explain values in ~x0:~%" fn2))
        (connections2-result (try-to-express-params-with-params args-traces2 arity2 formals2 args-traces1 arity1 formals1 formal-to-old-var-alist unchanged-components explanation-graph
                                                                connections1))
;(explanation-graph (first connections2-result)) ;;we don't need this. maybe print it?
        (connections2 (second connections2-result))
        (dummy5d (cw "Connections2: ~x0)~%" connections2))
        ;;currently, the user-specified connections are given for the function whose name comes first alphabetically (according to symbol<)
        ;;ffixme key off the second function name too? or off the sorted pair?
        (fn-with-connections (if (symbol< fn1 fn2) fn1 fn2))

;fixme what if these mention oldval?
        (user-supplied-connections (g :connections (g fn-with-connections extra-stuff))) ;can these mention old vars (they should call oldval instead?)? ;ffixme test these on the traces
        (vars-in-user-supplied-connections (get-vars-from-terms user-supplied-connections))
        )
     (declare (ignore dummy0 dummy1 dummy2 dummy3 dummy4 dummy5a dummy5b dummy5c dummy5d))
     (if (not (subsetp-eq vars-in-user-supplied-connections (append formals1 formals2)))
;fixme check this sooner? fixme start with user-supplied connections to avoid loops?
         (prog2$ (hard-error 'generate-connection-lemma-for-nice-tail-rec-fns "Vars mentioned in user supplied connections (~x0) are not all among the formals of the functions (formals: ~x1,  ~x2))."
                             (acons #\0 vars-in-user-supplied-connections
                                    (acons #\1 formals1
                                           (acons #\2 formals2
                                                  nil))))

                 (mv t nil nil rand state))
       (let*
           ( ;;Test the user-supplied connections on the traces: fixme should this throw an error?
            (user-supplied-connections (discard-false-connections user-supplied-connections args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist nil))
            (connections-to-remove (g :connections-to-remove (g fn-with-connections extra-stuff)))
            (dummy5 (progn$ (cw "(user-supplied connections: ~x0)~%" user-supplied-connections)
                            (cw "(user-supplied connections to remove: ~x0)~%" connections-to-remove)))
            (connections1 (set-difference-equal connections1 connections-to-remove))
            (connections2 (set-difference-equal connections2 connections-to-remove))

            (connections1 (union-equal user-supplied-connections connections1)) ;cycles possible in this? add the user-supplied connections first and update the explanation-graph with them?!

            (connections2 connections2 ;(remove-connections-that-might-loop connections2 connections1) ;trying without since since now we should not get cycles?
                          )            ;fffixme what about other cycles?
            (connections (append connections1 connections2))
            ;; drops "connections" like (EQUAL (LEN FACC) '5) that don't mention formals from both functions:
            (connections (drop-items-that-dont-have-vars-from-both-sets connections (append old-vars1 formals1) (append old-vars2 formals2))) ;allowing old vars here is new
            (connections (discard-false-connections connections args-traces1 args-traces2 formals1 formals2 interpreted-function-alist old-var-to-formal-alist nil)) ;could drop this check...
            ;;new:
            ;;(connections (orient-equalities connections)) ;seemed to allow loops ;Tue Jan 19 08:53:04 2010 (may not have been the problem, but might be in the future?)
            (dummy6 (cw "(Connections: ~x0)~%" connections))
;ffixme if there are no connections (or no good ones?), this whole attempt should fail?

            ;; now show that the updates preserve the connections (given the invars and the negated exit tests)
            (formal-update-expr-alist1 (pairlis$ formals1 update-expr-list1))
            (formal-update-expr-alist2 (pairlis$ formals2 update-expr-list2))
            (formal-update-expr-alist (append formal-update-expr-alist1 formal-update-expr-alist2))
            (dummy7 (cw "(formal-update-expr-alist: ~x0)~%" formal-update-expr-alist))

;            (connection-conjuncts-of-updates (sublis-var-simple-lst formal-update-expr-alist connections))

            (fn1-invariant-name (g-safe :invariant-name fn1-analyzed-function-info)) ;ffixme if this would give an error because the function should have been replaced, perhaps this routine should fail so we split the miter?
            (fn2-invariant-name (g-safe :invariant-name fn2-analyzed-function-info))
            (fn1-updates-preserve-invariant-theorem-name (g-safe :updates-preserve-invariant-theorem-name fn1-analyzed-function-info))
            (fn2-updates-preserve-invariant-theorem-name (g-safe :updates-preserve-invariant-theorem-name fn2-analyzed-function-info))
            (fn1-main-theorem-name (g-safe :main-theorem-name fn1-analyzed-function-info))
            (fn2-main-theorem-name (g-safe :main-theorem-name fn2-analyzed-function-info))

            (original-fn1-invariant-formals (fn-formals fn1-invariant-name (w state)))
            (original-fn2-invariant-formals (fn-formals fn2-invariant-name (w state)))

            (fn1-invariant-formals (sublis-var-simple-lst formal-and-old-var-renaming-alist1 original-fn1-invariant-formals))
            (fn2-invariant-formals (sublis-var-simple-lst formal-and-old-var-renaming-alist2 original-fn2-invariant-formals))
            (fn1-invariant-call `(,fn1-invariant-name ,@fn1-invariant-formals))
            (fn2-invariant-call `(,fn2-invariant-name ,@fn2-invariant-formals))

            (fn1-invariant-body (fn-body fn1-invariant-name t (w state)))
            (fn2-invariant-body (fn-body fn2-invariant-name t (w state)))

            (fn1-invars (get-conjuncts fn1-invariant-body))
            (fn2-invars (get-conjuncts fn2-invariant-body))
;rename them to use f and g:
            (fn1-invars (sublis-var-simple-lst formal-and-old-var-renaming-alist1 fn1-invars))
            (fn2-invars (sublis-var-simple-lst formal-and-old-var-renaming-alist2 fn2-invars))

            ;;ffixme don't we already deal with the exit test of each function separately?

            ;;ffixme (could do this elsewhere too, but maybe elsewhere we eventually call the dag prover, so it's okay?):
            ;; we open up the exit-test functions if appropriate:
            (exit-test-expr1-fns-to-open (and (call-of-user-fn-on-formalsp exit-test-expr1 formals1)
                                              (list (ffn-symb exit-test-expr1))))
            (exit-test-expr2-fns-to-open (and (call-of-user-fn-on-formalsp exit-test-expr2 formals2)
                                              (list (ffn-symb exit-test-expr2))))
            (dummy8 (cw "(Simplifying exit test 1:~%")))
         (declare (ignore dummy5 dummy6 dummy7 dummy8))
         (mv-let ( ;;we prove below that this is the same as the original expr
;fffixme can we here turn the "or in terms of if" into a boolor?
                  erp simplified-exit-test-expr1 state)
           (simp-term exit-test-expr1
                      :rules
                      (append exit-test-expr1-fns-to-open ;(cons-onto-all ':definition (enlist-all exit-test-expr1-fns-to-open))
                              (exit-test-simplification-rules))
                      :print t
                      :monitor
                      '( ;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger
;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger-alt
                        )
                      :assumptions fn1-invars
                      :normalize-xors nil
                      :check-inputs nil)
           (if erp
               (mv erp nil nil rand state)
             (let* ((simplified-exit-test-expr1 (dag2term simplified-exit-test-expr1))
                    (dummy9 (cw "Simplified exit test expr 1: ~x0)~%" simplified-exit-test-expr1))
                    (dummy10 (cw "(Simplifying exit test 2:~%")))
               (declare (ignore dummy9 dummy10))
               (mv-let
                 ;;we prove below that this is the same as the original expr
                 (erp simplified-exit-test-expr2 state)
                 (simp-term exit-test-expr2
                            :rules
                            (append exit-test-expr2-fns-to-open ;(cons-onto-all ':definition (enlist-all exit-test-expr2-fns-to-open))
                                    (exit-test-simplification-rules))
                            :print t
                            :monitor
                            '( ;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger
;sbvlt-of-0-and-bvplus-of-bvuminus-one-bigger-alt
                              )
                            :assumptions fn2-invars
                            :normalize-xors nil
                            :check-inputs nil)
                 (if erp
                     (mv erp nil nil rand state)
                   (let* ((simplified-exit-test-expr2 (dag2term simplified-exit-test-expr2))
                          (dummy11 (cw "Simplified exit test expr 2: ~x0)~%" simplified-exit-test-expr2))
                          (simplified-exit-test1-theorem-name (packnew fn1 '-simplified-exit-test-theorem))
                          (simplified-exit-test2-theorem-name (packnew fn2 '-simplified-exit-test-theorem))
                          (state (submit-events-brief
                                  ;;ffixme just call one of the axe routines to prove this?
                                  `((defthm ,simplified-exit-test1-theorem-name
                                      (implies ,fn1-invariant-call
                                               (iff ,exit-test-expr1
                                                    ,simplified-exit-test-expr1))
                                      :rule-classes nil
                                      :hints (("Goal"
                                               :in-theory (union-theories (theory 'minimal-theory)
                                                                          '(,fn1-invariant-name))
                                               :do-not '(generalize eliminate-destructors))
                                              (if stable-under-simplificationp
                                                  '(:clause-processor
                                                    (axe-prover
                                                     clause
                                                     ',(s :goal-name simplified-exit-test1-theorem-name
                                                          (axe-prover-hints
                                                           (append exit-test-expr1-fns-to-open ;(cons-onto-all ':definition (enlist-all exit-test-expr1-fns-to-open))
                                                                   (exit-test-simplification-proof-rules))
                                                           (empty-rule-alist)
                                                           interpreted-function-alist
                                                           analyzed-function-table))
                                                     state)
                                                    :do-not '(generalize eliminate-destructors))
                                                nil)))

                                    ;;ffixme use the better way of expanding and simplifying a function...
                                    (defthm ,simplified-exit-test2-theorem-name
                                      (implies ,fn2-invariant-call
                                               (iff ,exit-test-expr2
                                                    ,simplified-exit-test-expr2))
                                      :rule-classes nil
                                      :hints (("Goal"
                                               :in-theory (union-theories (theory 'minimal-theory)
                                                                          '(,fn2-invariant-name))
                                               :do-not '(generalize eliminate-destructors))
                                              (if stable-under-simplificationp
                                                  '(:clause-processor
                                                    (axe-prover
                                                     clause
                                                     ',(s :goal-name simplified-exit-test2-theorem-name
                                                          (axe-prover-hints
                                                           (append exit-test-expr2-fns-to-open ;(cons-onto-all ':definition (enlist-all exit-test-expr2-fns-to-open))
                                                                   (exit-test-simplification-proof-rules))
                                                           (empty-rule-alist) ; (fffixme turn off the built in dag prover rules?)
                                                           interpreted-function-alist
                                                           analyzed-function-table))
                                                     state)
                                                    :do-not '(generalize eliminate-destructors))
                                                nil))))
                                  state))
                          (negated-exit-test-conjuncts1 (conjuncts-for-negation simplified-exit-test-expr1)) ;just does propositional simplifications?
                          (negated-exit-test-conjuncts2 (conjuncts-for-negation simplified-exit-test-expr2))
                          (negated-exit-test1-theorem-name (packnew fn1 '-negated-simplified-exit-test-theorem))
                          (negated-exit-test2-theorem-name (packnew fn2 '-negated-simplified-exit-test-theorem))
                          (state (submit-events-brief `((defthm ,negated-exit-test1-theorem-name
                                                    (iff (not ,simplified-exit-test-expr1)
                                                         (and ,@negated-exit-test-conjuncts1))
                                                    :rule-classes nil
                                                    :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                               '(boolor))
                                                             :do-not '(generalize eliminate-destructors))))

                                                  (defthm ,negated-exit-test2-theorem-name
                                                    (iff (not ,simplified-exit-test-expr2)
                                                         (and ,@negated-exit-test-conjuncts2))
                                                    :rule-classes nil
                                                    :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                               '(boolor))
                                                             :do-not '(generalize eliminate-destructors)))))
                                                state))

                          ;;        (invariant-call1 (cons invariant-name1 invariant1-formals))
                          ;;        (invariant-call2 (cons invariant-name2 invariant2-formals))
                          ;;        (invariant-call1 (sublis-var-simple formal-renaming-alist1 invariant-call1))
                          ;;        (invariant-call2 (sublis-var-simple formal-renaming-alist2 invariant-call2))
;perhaps don't include the oldvars (and their corresponding test case values?)

;the last element of each trace is the base case and so should not be considered (the update fns are not called in the base cases):
;this is now done by make-test-cases-for-formals-and-old-vars:
;                           (args-traces1-except-last (map-drop-last args-traces1)) ;fixme remove empty traces?
;                          (args-traces2-except-last (map-drop-last args-traces2))

                          (test-cases-for-formals-and-old-vars1 (make-test-cases-for-formals-and-old-vars formals1 old-var-to-formal-alist1 args-traces1 ;args-traces1-except-last
                                                                                                          ))
                          (test-cases-for-formals-and-old-vars2 (make-test-cases-for-formals-and-old-vars formals2 old-var-to-formal-alist2 args-traces2 ;args-traces2-except-last
                                                                                                          ))
                          (test-cases-for-formals-and-old-vars (append-list test-cases-for-formals-and-old-vars1 test-cases-for-formals-and-old-vars2)) ;expensive?
                          (dummy12 (cw "(~x0 invars (previously proved in ~x2): ~x1)" fn1 fn1-invars fn1-invariant-name))
                          (dummy13 (cw "(~x0 invars (previously proved in ~x2): ~x1)" fn2 fn2-invars fn2-invariant-name)))
                     (declare (ignore dummy11 dummy12 dummy13))
                     (mv-let
                       (erp proved-connections connection-defthm-names rand state)
                       (find-maximal-inductive-set-of-invars connections
                                                             (packnew fn1 '-and- fn2 '-updates-preserve-connection-)
                                                             formal-update-expr-alist
                                                             (append negated-exit-test-conjuncts1
                                                                     negated-exit-test-conjuncts2
                                                                     fn1-invars
                                                                     fn2-invars)
                                                             0 rewriter-rule-alist prover-rule-alist
                                                             extra-stuff interpreted-function-alist
                                                             test-cases-for-formals-and-old-vars
                                                             miter-depth-to-use unroll monitored-symbols print max-conflicts options rand state)
                       (if erp
                           (mv erp nil nil rand state)
                         ;; (connection-defthm-names state)
                         ;; ;; prove that each connection conjunct is preserved by the updates
                         ;; ;; should we wrap the conjuncts up into functions?
                         ;; ;; define a big connection pred for the conjunction?
                         ;; (prove-connection-conjuncts connection-conjuncts-of-updates
                         ;;                             (append negated-exit-test-conjuncts1
                         ;;                                     negated-exit-test-conjuncts2
                         ;;                                     fn1-invars
                         ;;                                     fn2-invars
                         ;;                                     connections)
                         ;;                             (packnew fn1 '-and- fn2 '-updates-preserve-connection-)
                         ;;                             rewriter-rule-alist
                         ;;                             prover-rule-alist extra-stuff interpreted-function-alist
                         ;;                             test-cases-for-formals-and-old-vars ;these are over the (renamed) formals of both fns (and the old vars)
                         ;;                             miter-depth-to-use nil print monitored-symbols analyzed-function-table unroll max-conflicts state)
                         ;; now use the proved connections and the invariants to do the induction proof:
                         (b* ((connection-predicate-name (packnew fn1 '-and- fn2 '-connection-predicate))
                              (connection-predicate-vars (get-vars-from-terms proved-connections)) ;can there be old vars in the connections?
                              ;;puts them in the right order:
                              (connection-predicate-formals-from-formals1 (intersection-eq formals1 connection-predicate-vars))
                              (connection-predicate-formals-from-formals2 (intersection-eq formals2 connection-predicate-vars))
                              (connection-predicate-formals-from-formals (append connection-predicate-formals-from-formals1
                                                                                 connection-predicate-formals-from-formals2))
                              (connection-predicate-formals-from-old-vars1 (intersection-eq old-vars1 connection-predicate-vars))
                              (connection-predicate-formals-from-old-vars2 (intersection-eq old-vars2 connection-predicate-vars))

                              (connection-predicate-formals (append connection-predicate-formals-from-formals
                                                                    connection-predicate-formals-from-old-vars1
                                                                    connection-predicate-formals-from-old-vars2))

                              (connection-predicate-of-updates-helper-theorem-name (packnew connection-predicate-name '-of-updates-helper))
                              (connection-predicate-of-updates-theorem-name (packnew connection-predicate-name '-of-updates))

                              (connection-implies-exits-agree-theorem-name (packnew connection-predicate-name '-implies-exits-agree))
                              (state (submit-events-brief `((defun ,connection-predicate-name ,connection-predicate-formals
                                                        (declare (xargs :normalize nil))
                                                        ,(make-conjunction-from-list proved-connections))

                                                      ;;ffixme just call one of the axe routines to prove this?
                                                      (defthm ,connection-implies-exits-agree-theorem-name
                                                        (implies (and (,connection-predicate-name ,@connection-predicate-formals)
                                                                      ,fn1-invariant-call
                                                                      ,fn2-invariant-call)
                                                                 (iff ,exit-test-expr1
                                                                      ,exit-test-expr2))
                                                        :rule-classes nil
                                                        :hints (("Goal"
                                                                 :in-theory (union-theories '(,connection-predicate-name)
                                                                                            (theory 'minimal-theory))
                                                                 :do-not '(generalize eliminate-destructors))
                                                                (if stable-under-simplificationp
                                                                    '(:clause-processor
                                                                      (axe-prover
                                                                       clause
                                                                       ',(s :print print
                                                                            (s :goal-name connection-implies-exits-agree-theorem-name
                                                                               (axe-prover-hints
                                                                                nil
                                                                                prover-rule-alist interpreted-function-alist
                                                                                analyzed-function-table
                                                                                )))
                                                                       state)
                                                                      :do-not '(generalize eliminate-destructors))
                                                                  nil)))

                                                      (defthm ,connection-predicate-of-updates-helper-theorem-name
                                                        (implies (and (,connection-predicate-name ,@connection-predicate-formals)
                                                                      ,@fn1-invars
                                                                      ,@fn2-invars
                                                                      ,@negated-exit-test-conjuncts1
                                                                      ,@negated-exit-test-conjuncts2)
                                                                 (,connection-predicate-name ,@(lookup-eq-lst connection-predicate-formals-from-formals formal-update-expr-alist)
                                                                                             ,@connection-predicate-formals-from-old-vars1
                                                                                             ,@connection-predicate-formals-from-old-vars2))
                                                        :rule-classes nil
                                                        :hints (("Goal" :use (,@connection-defthm-names)
                                                                 :in-theory (union-theories
                                                                             (theory 'minimal-theory)
                                                                             '(,connection-predicate-name)))))

                                                      ;;close up the individual functions' invars:
;fffffixme think about old-vars here...for some reason this had OLD-NEW-PARAMS instead of GOLD-NEW-PARAMS - may be fixed now..
                                                      (defthm ,connection-predicate-of-updates-theorem-name
                                                        (implies (and (,connection-predicate-name ,@connection-predicate-formals)
                                                                      ,fn1-invariant-call
                                                                      ,fn2-invariant-call
                                                                      ,@negated-exit-test-conjuncts1
                                                                      ,@negated-exit-test-conjuncts2)
                                                                 (,connection-predicate-name ,@(lookup-eq-lst connection-predicate-formals-from-formals formal-update-expr-alist)
                                                                                             ,@connection-predicate-formals-from-old-vars1
                                                                                             ,@connection-predicate-formals-from-old-vars2))
                                                        :rule-classes nil
                                                        :hints (("Goal" :use ,connection-predicate-of-updates-helper-theorem-name
                                                                 :in-theory (union-theories (theory 'minimal-theory)
                                                                                            '(,fn1-invariant-name ,fn2-invariant-name))))))
                                                    state))

                              ;; Analyze the final values:
                              (last-tuples1 (map-last-elem args-traces1)) ;one tuple per trace
                              (last-tuples2 (map-last-elem args-traces2)) ;one tuple per trace
                              (formals-last-vals-lst1 (get-nths-from-values arity1 last-tuples1)) ;in sync with the formals: each entry is for one formal and gives the last val of that formal on each trace
                              (formals-last-vals-lst2 (get-nths-from-values arity2 last-tuples2)) ;in sync with the formals: each entry is for one formal and gives the last val of that formal on each trace

                              ;;this can now find more than one explanation for the same RV (in case some don't prove):
                              ;;fixme don't bother with any values that are not returned? or that aren't referenced by the parent of this rec fn in the overarching DAG?
                              ;;fixme pass in old vals?
                              (- (cw "(Looking for final claims:~%"))
                              (discovered-final-claims1 (try-to-express-last-value-of-target-tree-list-with-any-candidate
                                                         formals1
                                                         formals-last-vals-lst1
                                                         (pairlis$ formals2 formals-last-vals-lst2)
                                                         nil))
                              (discovered-final-claims2 (try-to-express-last-value-of-target-tree-list-with-any-candidate
                                                         formals2
                                                         formals-last-vals-lst2
                                                         (pairlis$ formals1 formals-last-vals-lst1)
                                                         nil))
                              (discovered-final-claims (append discovered-final-claims1 discovered-final-claims2))
                              (- (cw "Discovered final claims: ~x0)" discovered-final-claims))
                              (new-final-claims (set-difference-equal
                                                 (set-difference-equal
                                                  (set-difference-equal discovered-final-claims
                                                                        proved-connections)
                                                  fn1-invars)
                                                 fn2-invars))
                              ;;fixme allow user-supplied rv claims?
                              (- (cw "(New final claims: ~x0)~%" new-final-claims))
                              ;; Attempt to prove the final claims using the exit tests:
                              ((mv erp proved-new-final-claims final-claims-defthm-names state)
                               (prove-final-claims new-final-claims
                                                   (list* simplified-exit-test-expr1
                                                          simplified-exit-test-expr2
                                                          fn1-invariant-call
                                                          fn2-invariant-call
                                                          proved-connections)
                                                   (pack$ fn1 '-and- fn2 '-final-claim-) max-conflicts prover-rule-alist
                                                   `(,fn1-invariant-name ;because these will need to be opened
                                                     ,fn2-invariant-name)
                                                   interpreted-function-alist state))
                              ((when erp) (mv erp nil nil rand state))
                              (- (cw "(Proved new final claims: ~x0)~%" proved-new-final-claims))
;(proved-final-claims (append proved-new-final-claims proved-connections))
                              (proved-final-claim-formals (intersection-eq  (append formals1 old-vars1 formals2 old-vars2) (get-vars-from-terms proved-new-final-claims)))
                              (proved-final-claim-name (packnew fn1 '-and- fn2 '-final-claim))
                              (proved-final-claim-lemma-name (packnew proved-final-claim-name '-lemma))
                              (proved-final-claim-lemma-name-helper (packnew proved-final-claim-lemma-name '-helper))
                              (state
                               (submit-events-brief `( ;fixme could proved-final-claim-formals include more than better-invariant-formals?
                                                ;;do we need both this and the rv predicate?  well, the rv predicate is over rv, not the formals...
                                                (defun ,proved-final-claim-name (,@proved-final-claim-formals)
                                                  (declare (xargs :normalize nil))
                                                  (and ,@proved-new-final-claims))

                                                ;;easy, just by opening the definition
                                                ;;prove the final claim (using the theorems generated when strengthening)
                                                (defthm ,proved-final-claim-lemma-name-helper
                                                  (implies (and ,simplified-exit-test-expr1
                                                                ,simplified-exit-test-expr2
                                                                ,fn1-invariant-call
                                                                ,fn2-invariant-call
                                                                (,connection-predicate-name ,@connection-predicate-formals)
                                                                )
                                                           (,proved-final-claim-name ,@proved-final-claim-formals))
                                                  :rule-classes nil
                                                  :hints (("goal" :in-theory (union-theories (theory 'minimal-theory)
                                                                                             '(,proved-final-claim-name
                                                                                               ,fn1-invariant-name
                                                                                               ,fn2-invariant-name
                                                                                               ,connection-predicate-name))
                                                           :use (,@final-claims-defthm-names)
                                                           :do-not '(generalize eliminate-destructors))))

                                                ;;change the exit tests:
                                                (defthm ,proved-final-claim-lemma-name
                                                  (implies (and ,exit-test-expr1
                                                                ,exit-test-expr2
                                                                ,fn1-invariant-call
                                                                ,fn2-invariant-call
                                                                (,connection-predicate-name ,@connection-predicate-formals))
                                                           (,proved-final-claim-name ,@proved-final-claim-formals))
                                                  :rule-classes nil
                                                  :hints (("goal" :in-theory (theory 'minimal-theory)
                                                           :use (,proved-final-claim-lemma-name-helper
                                                                 ,simplified-exit-test1-theorem-name
                                                                 ,simplified-exit-test2-theorem-name)
                                                           :do-not '(generalize eliminate-destructors)))))
                                              state))

                              ;;make the predicate over the RVs of the functions (some formals may not be returned):

                              (single-param-base-casep1 (symbolp base-case-expr1))
                              (formals-mentioned-in-base-case1 (if single-param-base-casep1
                                                                   (list base-case-expr1)
                                                                 (get-consed-items-from-cons-nest base-case-expr1)))
                              (- (cw "(formals-mentioned-in-base-case1: ~x0)~%"formals-mentioned-in-base-case1))

                              (single-param-base-casep2 (symbolp base-case-expr2))
                              (formals-mentioned-in-base-case2 (if single-param-base-casep2
                                                                   (list base-case-expr2)
                                                                 (get-consed-items-from-cons-nest base-case-expr2)))
                              (- (cw "(formals-mentioned-in-base-case2: ~x0)~%"formals-mentioned-in-base-case2))

                              ;;pairs each formal that is returned with its expression in terms of 'rv1:
                              (formal-rv-component-alist1 (if single-param-base-casep1
                                                              (acons-fast base-case-expr1 'rv1 nil)
                                                            (pairlis$ formals-mentioned-in-base-case1
                                                                        (make-nth-terms
                                                                         (len formals-mentioned-in-base-case1)
                                                                         'rv1))))

                              ;;pairs each formal that is returned with its expression in terms of 'rv2:
                              (formal-rv-component-alist2 (if single-param-base-casep2
                                                              (acons-fast base-case-expr2 'rv2 nil)
                                                            (pairlis$ formals-mentioned-in-base-case2
                                                                        (make-nth-terms
                                                                         (len formals-mentioned-in-base-case2)
                                                                         'rv2))))
                              (formal-rv-component-alist (append formal-rv-component-alist1 formal-rv-component-alist2))

;drop connections that mention any non-returned formals:
                              (connections-for-rv-predicate
                               (keep-terms-that-mention-only (append formals-mentioned-in-base-case1
                                                                     formals-mentioned-in-base-case2
                                                                     old-vars1
                                                                     old-vars2)
                                                             (append proved-new-final-claims proved-connections)))

                              ;; remove any connections that are only about old vars (will there be any of these?):
                              (connections-to-remove-from-rv-predicate (keep-terms-that-mention-only (append old-vars1 old-vars2) connections-for-rv-predicate))
                              (connections-for-rv-predicate (set-difference-equal connections-for-rv-predicate connections-to-remove-from-rv-predicate))
;ffffixme handle the case of connections-for-rv-predicate empty...

                              ;;these are over rv1/rv2 and the old-vars:
                              ;;ffixme what if one or both list is empty?
                              (conjuncts-for-rv-predicate (sublis-var-simple-lst formal-rv-component-alist connections-for-rv-predicate))

                              (all-vars-mentioned-in-rv-predicate (get-vars-from-terms conjuncts-for-rv-predicate))
                              (old-vars-mentioned-in-rv-predicate1 ;; order matters?:
                               (intersection-eq old-vars1 all-vars-mentioned-in-rv-predicate))
                              (old-vars-mentioned-in-rv-predicate2 ;; order matters?:
                               (intersection-eq old-vars2 all-vars-mentioned-in-rv-predicate))

                              ;;ffixme what if rv1/rv2 are not mentioned in the rv predicate? can that happen?
                              (rv-predicate-formals
                               ;; order matters?:
                               (cons 'rv1 (cons 'rv2 (append old-vars-mentioned-in-rv-predicate1 old-vars-mentioned-in-rv-predicate2))))
                              (rv-predicate-name (packnew fn1 '-and- fn2 '-rv-predicate))

;zz
                              (rv-predicate-of-base-expr-theorem-name (packnew rv-predicate-name '-of-base-expr))


                              (conjuncts-for-rv-predicate-of-fn-calls (sublis-var-simple-lst (acons-fast 'rv1 `(,fn1 ,@formals1)
                                                                                                     (acons-fast 'rv2 `(,fn2 ,@formals2)
                                                                                                                 nil))
                                                                                         conjuncts-for-rv-predicate))

                              (conjuncts-for-rv-predicate-of-fn-calls-no-old-vars (sublis-var-simple-lst old-var-to-formal-alist conjuncts-for-rv-predicate-of-fn-calls))

                              (connection-theorem-name (packnew 'equivalence-of- fn1 '-and- fn2))
                              (connection-theorem-helper-name (packnew connection-theorem-name '-helper))
                              (connection-theorem-helper2-name (packnew connection-theorem-name '-helper2))
                              (connection-theorem-helper3-name (packnew connection-theorem-name '-helper3))
                              (connection-theorem-helper4-name (packnew connection-theorem-name '-helper4))
                              (induction-fn-name (packnew 'joint-induct- fn1 '-and- fn2))
                              (state (submit-event-brief (make-induction-function fn1 fn2 induction-fn-name state) state))
                              (proved-final-claim-implies-rv-predicate-theorem-name (packnew proved-final-claim-name '-implies- rv-predicate-name))
                              (state (submit-events-brief
                                      `((defun ,rv-predicate-name ,rv-predicate-formals
                                          (declare (xargs :normalize nil))
                                          ,(make-conjunction-from-list conjuncts-for-rv-predicate))

                                        ;; proves that the final claim implies the rv pred of the base case (easy) ;rename
                                        (defthm ,proved-final-claim-implies-rv-predicate-theorem-name
                                          (implies (and (,proved-final-claim-name ,@proved-final-claim-formals)
                                                        (,connection-predicate-name ,@connection-predicate-formals))
                                                   (,rv-predicate-name ,base-case-expr1 ,base-case-expr2
                                                                       ,@old-vars-mentioned-in-rv-predicate1
                                                                       ,@old-vars-mentioned-in-rv-predicate2))
                                          :rule-classes nil
                                          :hints (("Goal"
                                                   :do-not '(generalize eliminate-destructors)
                                                   :in-theory (union-theories
                                                               (theory 'minimal-theory)
                                                               '(,proved-final-claim-name
                                                                 ,rv-predicate-name
                                                                 ,connection-predicate-name
                                                                 (:rewrite nth-of-cons-constant-version) ;other list lemmas?
                                                                 (:executable-counterpart zp)
                                                                 (:executable-counterpart binary-+))))))

                                        ;;analogous to exit-test-and-better-invar-imply-rv-predicate-theorem-name in the 1-loop case
                                        (defthm ,rv-predicate-of-base-expr-theorem-name
                                          (implies (and (,connection-predicate-name ,@connection-predicate-formals)
                                                        ,exit-test-expr1
                                                        ,exit-test-expr2
                                                        ,fn1-invariant-call
                                                        ,fn2-invariant-call)
                                                   (,rv-predicate-name ,base-case-expr1 ,base-case-expr2
                                                                       ,@old-vars-mentioned-in-rv-predicate1
                                                                       ,@old-vars-mentioned-in-rv-predicate2))
                                          :hints (("Goal" :use (,proved-final-claim-implies-rv-predicate-theorem-name
                                                                ,proved-final-claim-lemma-name)
                                                   :in-theory (theory 'minimal-theory)))
                                          ;; :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
                                          ;;                                            '(NTH-OF-CONS-CONSTANT-VERSION
                                          ;;                                              (:executable-counterpart zp)
                                          ;;                                              (:executable-counterpart binary-+)
                                          ;;                                              ,connection-predicate-name
                                          ;;                                              ,rv-predicate-name))))
                                          :rule-classes nil)

                                        ;;The main induction proof:
                                        ;;ffixme use the hide trick??
                                        (defthm ,connection-theorem-helper-name
                                          (implies (and (,connection-predicate-name ,@connection-predicate-formals)
                                                        ,fn1-invariant-call
                                                        ,fn2-invariant-call)
                                                   (,rv-predicate-name (,fn1 ,@formals1)
                                                                       (,fn2 ,@formals2)
                                                                       ,@old-vars-mentioned-in-rv-predicate1
                                                                       ,@old-vars-mentioned-in-rv-predicate2))
                                          :rule-classes nil
                                          :hints (("Goal"
                                                   :induct (,induction-fn-name ,@formals1 ,@formals2)
                                                   :do-not '(generalize eliminate-destructors)
                                                   :in-theory (union-theories
                                                               (theory 'minimal-theory)
                                                               '(,induction-fn-name ,fn1 ,fn2)))
                                                  (and stable-under-simplificationp
;fixme could lay down a sequence of theorems, :use-ing some of these lemmas one at a time?
                                                       '(:use (,simplified-exit-test2-theorem-name ;drop?
                                                               ,simplified-exit-test1-theorem-name ;drop?
                                                               ,negated-exit-test1-theorem-name
                                                               ,negated-exit-test2-theorem-name
                                                               ,connection-implies-exits-agree-theorem-name
                                                               ,rv-predicate-of-base-expr-theorem-name
                                                               ,connection-predicate-of-updates-theorem-name ;fix to use the basic exit tests and don't reason about that issue here
                                                               ;;think about these substitutions (what about old vars! what about name clashes?):
                                                               (:instance ,fn1-updates-preserve-invariant-theorem-name
                                                                          ,@(alist-to-doublets (filter-alist-pairs
                                                                                                formal-and-old-var-renaming-alist1
                                                                                                original-fn1-invariant-formals)))
                                                               (:instance ,fn2-updates-preserve-invariant-theorem-name
                                                                          ,@(alist-to-doublets (filter-alist-pairs
                                                                                                formal-and-old-var-renaming-alist2
                                                                                                original-fn2-invariant-formals))))
                                                              :do-not '(generalize eliminate-destructors)
                                                              :in-theory (union-theories
                                                                          (theory 'minimal-theory)
                                                                          '(,induction-fn-name ,fn1 ,fn2))))))

                                        ;;opens up the conclusion and the first hyp (delays opening the first hyp?):
                                        (defthm ,connection-theorem-helper2-name
                                          (implies (and ,(make-conjunction-from-list proved-connections) ;;(,connection-predicate-name ,@connection-predicate-formals)
                                                        ,fn1-invariant-call
                                                        ,fn2-invariant-call
                                                        )
                                                   ,(make-conjunction-from-list conjuncts-for-rv-predicate-of-fn-calls))
                                          :rule-classes nil
                                          :hints (("Goal" :use (:instance ,connection-theorem-helper-name)
                                                   :in-theory (union-theories
                                                               (theory 'minimal-theory)
                                                               '(,rv-predicate-name
                                                                 ,connection-predicate-name)))))

                                        ;;instantiates old vars (fffixme think this through)
                                        (defthm ,connection-theorem-helper3-name
                                          (implies (and ,(make-conjunction-from-list (sublis-var-simple-lst old-var-to-formal-alist proved-connections)) ;;(,connection-predicate-name ,@connection-predicate-formals)
                                                        (,fn1-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist1 fn1-invariant-formals))
                                                        (,fn2-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist2 fn2-invariant-formals))
                                                        )
                                                   ,(make-conjunction-from-list conjuncts-for-rv-predicate-of-fn-calls-no-old-vars))
                                          :rule-classes nil
                                          :hints (("Goal" :use (:instance ,connection-theorem-helper2-name
                                                                          ,@(alist-to-doublets old-var-to-formal-alist)
                                                                          )
                                                   :in-theory (theory 'minimal-theory)))))
                                      state))
                              ;; simplify the conclusions.  This uses the individual theorems about the two functions.  So if a conclusion mentions, say, RV3 of F but F's theorem says that RV3 is 0 upon return from F, 0 is put in its place.
                              ;;fffixme make this into a full strengthening phase, including using user-supplied strengthenings..
                              ;;fixme some hyps are not being opened in this?

                              ((mv erp simplified-conclusions simplified-conclusion-defthm-names state)
                               (prog2$
                                (cw "(Simplifying the connection relation applied to the RVs.~%")
;fffixme think about this..
;should we simplify before instantiating, analogously to how we improve the invars?
;fixme get rid of this step?
                                (simplify-conclusions conjuncts-for-rv-predicate-of-fn-calls-no-old-vars ;terms

;include as a hyp the connection predicate on the args?
;allow the user to specify strengthened concluions?
;use the negated exit tests?  maybe not?
                                                      (sublis-var-simple-lst old-var-to-formal-alist proved-connections) ;new!! can't use these to directly rewrite the conclusions (they need to be over the fn calls applied to distinct vars)
;hyps:
                                                      ;;fffixme do/should these get opened?
                                                      (list `(equal (,fn1-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist1 fn1-invariant-formals)) 't)
                                                            `(equal (,fn2-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist2 fn2-invariant-formals)) 't))
                                                      (cons `,fn1-main-theorem-name
                                                            (cons `,fn2-main-theorem-name
                                                                  ;;ffixme think about this
                                                                  '(prefixp-when-lens-equal
                                                                    take-does-nothing
                                                                    firstn-becomes-take-gen
                                                                    true-list-fix-when-true-listp)))
                                                      max-conflicts
;monitored symbols (inefficient but remember that each theorem can generate several dag rules):
                                                      (cons 'prefixp-when-lens-equal
                                                            ;; TODO: Use plain make-axe-rules here
                                                            (map-rule-symbol (make-axe-rules! (list `,fn1-main-theorem-name
                                                                                                    `,fn2-main-theorem-name)
                                                                                              (w state))))
                                                      nil
                                                      nil
                                                      0
                                                      (packnew fn1 '-and- fn2 '-simplified-conclusion-)
                                                      (list fn1-invariant-name fn2-invariant-name)
                                                      prover-rule-alist interpreted-function-alist
                                                      state)))
                              ((when erp) (mv erp nil nil rand state))
                              (- (cw "Done simplifying the connection relation)~%"))
                              (simplified-conclusions (remove-equal *t* simplified-conclusions))
                              (state (submit-events-brief `((defthm ,connection-theorem-helper4-name
                                                        (implies (and ,(make-conjunction-from-list (sublis-var-simple-lst old-var-to-formal-alist proved-connections)) ;;(,connection-predicate-name ,@connection-predicate-formals)
                                                                      (,fn1-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist1 fn1-invariant-formals))
                                                                      (,fn2-invariant-name ,@(sublis-var-simple-lst old-var-to-formal-alist2 fn2-invariant-formals))
                                                                      )
                                                                 (and ,@simplified-conclusions))
                                                        :rule-classes nil
                                                        :hints (("Goal" :use (,connection-theorem-helper3-name
                                                                              ,@simplified-conclusion-defthm-names)
                                                                 :in-theory (union-theories (theory 'minimal-theory)
                                                                                            '((:type-prescription ,fn1-invariant-name)
                                                                                              (:type-prescription ,fn2-invariant-name)
                                                                                              )))))

                                                      ;;fixes up equalities in the conclusions to match better
                                                      ;;ffixme expand out the hyps?
;fixme split this into several steps?
                                                      ;; TODO: Some conclusions may explain a part of one function call as a constant.  In that case, the hyps will contain free vars (inside work-hard).
                                                      (defthm ,connection-theorem-name
                                                        (implies (and
                                                                  ,@(wrap-all
                                                                     'work-hard
                                                                     (append (sublis-var-simple-lst (pairlis$ original-fn1-invariant-formals (sublis-var-simple-lst old-var-to-formal-alist1 fn1-invariant-formals))
                                                                                                (get-conjuncts fn1-invariant-body))
                                                                             (sublis-var-simple-lst (pairlis$ original-fn2-invariant-formals (sublis-var-simple-lst old-var-to-formal-alist2 fn2-invariant-formals))
                                                                                                (get-conjuncts fn2-invariant-body))
                                                                             (sublis-var-simple-lst old-var-to-formal-alist proved-connections)) ;;(,connection-predicate-name ,@connection-predicate-formals)
                                                                     ))
                                                                 (and ,@(equate-items-to-t-both-ways simplified-conclusions) ;this may also prevent loops
                                                                      ))
                                                        :rule-classes nil
                                                        :hints (("Goal" :use (,connection-theorem-helper4-name)
                                                                 :in-theory (union-theories '(work-hard
;these needed because of equate-items-to-t-both-ways.. fixme only do it for known booleans
;and include all their tp rules here?
                                                                                              (:type-prescription prefixp) ;fixme what else?
                                                                                              (:type-prescription sbvlt)
                                                                                              (:type-prescription bvlt)
                                                                                              (:type-prescription unsigned-byte-p)
                                                                                              (:type-prescription all-unsigned-byte-p)
                                                                                              ,fn1-invariant-name
                                                                                              ,fn2-invariant-name)
                                                                                            (theory 'minimal-theory))))))
                                                    state))
                              (-  (cw "Done with connection lemma.)~%")))
                           (mv (erp-nil)
                               (list `,connection-theorem-name)
                               (list connection-predicate-name ;fixme do we need to export this?
                                     )
                               rand state))))))))))))))

 ;;        ;;these are about both functions (should we allow params of the other function too?)
 ;;        ;;do we not want this for tail-rec functions?
 ;; ;fffixme go both ways here?:
 ;;        (dummy77 (cw ",,Finding cross rv equalities:~%"))
 ;;        (main-theorem-concs
 ;;         (assert-non-nil
 ;;          'main-theorem-concs (try-to-express-rv-with-rvs-and-params
 ;;                               function-call-term1 ;;-with-hide
 ;;                               traces1
 ;;                               function-call-term2 ;;-with-hide
 ;;                               traces2 arity2 formals2)))


 ;; ;fixme - if we equated a g param with an f param there's no need to generate type hyps for both of them...
 ;; ;fixme, which function should we rewrite to the other?
 ;; ;fixme - should we try to express g's params in terms of f's?  since we can then substitute into the expression of f in terms of g?

 ;;        (hyp-connections
 ;;         (try-to-express-params-with-params args-traces1 arity1 formals1
 ;;                                            args-traces2 arity2 formals2))
 ;;        ;;for tail rec. fns we can't capture this information with lemmas about the RVs of each
 ;;        ;;function separately:
 ;;        (hyp-connections-back
 ;;         (if fn1-tail-recp
 ;;             (try-to-express-params-with-params args-traces2 arity2 formals2
 ;;                                                args-traces1 arity1 formals1)
 ;;           nil))
 ;; ;fffixme we may have some equalities both ways!
 ;;        (hyp-connections (append hyp-connections hyp-connections-back))

 ;; ;we should consider dropping assertions about components that we know are constants?
 ;; ;eg is x is always 4 and y is always a list of length 3 - we'd get that x=1+len(y)

 ;;        (hyps (remove-duplicates-equal (append hyp-connections hyps1 hyps2)))
 ;;        (dummy (cw ",,Hyps are: ~x0" hyps))

 ;; ;fixme, make sure the calls to equal in the conclusion have args in the right order
 ;; ;fixme, only include info about return values we care about?
 ;; ;fixme, skip this if we are pre-simplifying?
 ;;        (fn1-theorem-name (pack$ 'generated-theorem-for-function- fn1))
 ;;        (fn2-theorem-name (pack$ 'generated-theorem-for-function- fn2))
 ;;
 ;; ;we don't check for errors here - okay?
 ;;        (hide-opener-name1 (pack$ fn1 '-hide-opener '-for-comparison))
 ;;        (hide-dropper-name1 (pack$ fn1 '-hide-dropper '-for-comparison))
 ;;        (hide-opener-name2 (pack$ fn2 '-hide-opener '-for-comparison))
 ;;        (hide-dropper-name2 (pack$ fn2 '-hide-dropper '-for-comparison))
 ;;        ;;do we still need the hide stuff if we are disabling the definitions of the functions?
 ;;        (state (make-hide-opener-and-dropper fn1 formals1 use-axe-proverp
 ;;                                             hide-opener-name1 hide-dropper-name1 state))
 ;;        (state (make-hide-opener-and-dropper fn2 formals2 use-axe-proverp
 ;;                                             hide-opener-name2 hide-dropper-name2 state))
 ;;
 ;; ;what does this do?
 ;;        (hyps (refine-hyps main-theorem-name hyps extra-stuff))
 ;;        (main-theorem-concs (append (get-extra-concs main-theorem-name extra-stuff) main-theorem-concs))
 ;; ;avoid doing this unless we need to?
 ;;        (test-cases-for-formals1 (make-test-cases-for-formals formals1 args-traces1))
 ;;        (test-cases-for-formals2 (make-test-cases-for-formals formals2 args-traces2))
 ;;        (test-cases-for-formals (append-list
 ;;                                 test-cases-for-formals1
 ;;                                 test-cases-for-formals2))
 ;;        )
 ;;     (declare (ignore dummy dummy77 ;dummy10 dummy11
 ;;                      dummy2a dummy2b))
 ;;     (mv-let
 ;;      (err result state)
 ;;      ;;abuse of progn for only 1 event?
 ;;      ..
 ;;      (declare (ignore err result))
 ;;      (mv-let
 ;;       (err state)
 ;;       (if fn1-tail-recp
 ;;           (mv nil state)           ;don't do it for tail-rec functions
 ;;         ;;ffixme don't spend time generating rv-equalities1 and rv-type-facts1 !
 ;; ;fixme, what if it can't be made into a good rule (e.g., no conjuncts?)
 ;;         (my-defthm-fn-rewrite-with-and-without-hides
 ;;          (list function-call-term1)
 ;;          fn1-theorem-name
 ;;          (refine-hyps fn1 hyps1 extra-stuff)
 ;;          (append (get-extra-concs fn1 extra-stuff)
 ;;                  (conclusion-conjuncts
 ;;                   rv-type-facts1
 ;;                   rv-equalities1))
 ;; ;fixme use minimal theory?
 ;;          `(("Goal" :do-not '(generalize eliminate-destructors)
 ;;             :in-theory (e/d ((:induction ,fn1))
 ;;                             ((:definition ,fn1)))
 ;;             :induct ,function-call-term1)
 ;;            ,@(if use-axe-proverp
 ;;                  `((if STABLE-UNDER-SIMPLIFICATIONP
 ;;                        '(:clause-processor
 ;;                          (axe-prover
 ;;                           clause
 ;;                           ',(axe-prover-hints
 ;;                              `((:nil ,hide-opener-name1)
 ;;                                (:nil ,hide-dropper-name1))
 ;;                              nil
 ;;                              interpreted-function-alist
 ;;                              (firstn 200 test-cases-for-formals1) ;ffixme
 ;;                              )
 ;;                           state))
 ;;                      nil))
 ;;                nil))
 ;;          state))
 ;;       (if err
 ;;           (mv :error nil nil dag-array state)
 ;;         (mv-let
 ;;          (err state)
 ;;          (if fn2-tail-recp
 ;;              (mv nil state)           ;don't do it for tail-rec functions
 ;;            ;;fixme use the -rewrite version above - and only when appropriate
 ;;            (my-defthm-fn-rewrite-with-and-without-hides
 ;;             (list function-call-term2)
 ;;             fn2-theorem-name
 ;;             (refine-hyps fn2 hyps2 extra-stuff)
 ;;             (append
 ;;              (get-extra-concs fn2 extra-stuff)
 ;;              (conclusion-conjuncts
 ;;               rv-type-facts2
 ;;               rv-equalities2))
 ;;             `(("Goal" :do-not '(generalize eliminate-destructors)
 ;;                :in-theory (e/d ((:induction ,fn2))
 ;;                                ((:definition ,fn2)))
 ;;                :induct ,function-call-term2)
 ;;               ,@(if use-axe-proverp
 ;;                     `((if STABLE-UNDER-SIMPLIFICATIONP
 ;;                           '(:clause-processor
 ;;                             (axe-prover
 ;;                              clause
 ;;                              ',(axe-prover-hints
 ;;                                 `((:nil ,hide-opener-name2)
 ;;                                   (:nil ,hide-dropper-name2))
 ;;                                 nil
 ;;                                 interpreted-function-alist
 ;;                                 (firstn 200 test-cases-for-formals2) ;ffixme
 ;;                                 )
 ;;                              state))
 ;;                         nil))
 ;;                   nil))
 ;;             state))
 ;;          (if err
 ;;              (mv :error nil nil dag-array state)
 ;;            (mv-let
 ;;             (err state)
 ;;             (if (endp main-theorem-concs)
 ;;                 (mv (prog2$ (hard-error 'try-to-prove-non-pure-nodes-equal
 ;;                                         "No conclusions found"
 ;;                                         nil)
 ;;                             t)
 ;;                     state)
 ;;               ;; Main theorem:
 ;;               (my-defthm-fn-rewrite-with-and-without-hides ;don't need rewrite here?
 ;;                (list function-call-term1 function-call-term2)
 ;;                main-theorem-name
 ;;                hyps
 ;;                main-theorem-concs
 ;;                `(("Goal" :do-not '(generalize eliminate-destructors)
 ;;                   :in-theory                 ;; (e/d ((:induction ,fn1)
 ;;                   ;;                                                                    (:induction ,fn2)
 ;;                   ;;                                                                    ;;ffixme if they disagree on being tail-rec
 ;;                   ;;                                                                    ;;we have big problems
 ;;                   ;;                                                                    ,@(if fn1-tail-recp nil (list fn1-theorem-name))
 ;;                   ;;                                                                    ,@(if fn2-tail-recp nil (list fn2-theorem-name)))
 ;;                   ;;                                                                   ((:definition ,fn1)
 ;;                   ;;                                                                    (:definition ,fn2)))
 ;;                   (union-theories (theory 'minimal-theory)
 ;;                                   '((:induction ,induction-fn-name)
 ;;                                     ;;ffixme if they disagree on being tail-rec
 ;;                                     ;;we have big problems
 ;;                                     ,@(if fn1-tail-recp nil (list fn1-theorem-name))
 ;;                                     ,@(if fn2-tail-recp nil (list fn2-theorem-name))))
 ;;                   :induct (,induction-fn-name
 ;;                            ,@formals1
 ;;                            ,@formals2))
 ;;                  ,@(if use-axe-proverp
 ;;                        `((if STABLE-UNDER-SIMPLIFICATIONP
 ;;                              '(:clause-processor
 ;;                                (axe-prover
 ;;                                 clause
 ;;                                 ',(s :print t
 ;;                                      (axe-prover-hints
 ;;                                       (append (if fn1-tail-recp nil (list `(:rewrite ,fn1-theorem-name)))
 ;;                                               (if fn2-tail-recp nil (list `(:rewrite ,fn2-theorem-name)))
 ;;                                               `((:nil ,hide-opener-name1)
 ;;                                                 (:nil ,hide-dropper-name1)
 ;;                                                 (:nil ,hide-opener-name2)
 ;;                                                 (:nil ,hide-dropper-name2)))
 ;;                                       prover-rule-alist ;;was nil
 ;;                                       interpreted-function-alist
 ;;                                       (firstn 200 test-cases-for-formals) ;ffixme
 ;;                                       ))
 ;;                                 state))
 ;;                            nil))
 ;;                      nil))
 ;;                state))
 ;;             (if err
 ;;                 (mv :error nil nil dag-array state)
 ;;               ;;we proved the theorem but might need to specialize it (e.g., if contains (nthcdr n x) where n evaluates to 0 on the initial function arguments
 ;;               (let*
 ;;                   ((f1-param-constant-alist (make-param-constant-alist formals1 args1))
 ;;                    (f2-param-constant-alist (make-param-constant-alist formals2 args2))
 ;;                    (param-constant-alist (append f1-param-constant-alist
 ;;                                                  f2-param-constant-alist))
 ;;                    (instantiated-main-theorem-hyps
 ;;                     (sublis-var-and-eval-lst2 param-constant-alist hyps nil))
 ;;                    ;;fixme consider passing in some functions?
 ;;                    (instantiated-main-theorem-conclusions
 ;;                     (sublis-var-and-eval-lst2 param-constant-alist
 ;;                                                 main-theorem-concs nil))
 ;;                    (instantiated-main-theorem-conclusions
 ;;                     (remove-hides-lst instantiated-main-theorem-conclusions))
 ;;                    (instantiated-main-theorem-hyps
 ;;                     (remove-hides-lst instantiated-main-theorem-hyps))
 ;;                    (instantiated-main-theorem-name
 ;;                     (mypackn (list 'instantiated- main-theorem-name))))
 ;;                 (mv-let
 ;;                  (err state)
 ;;                  (my-defthm-fn2 instantiated-main-theorem-name
 ;;                                 instantiated-main-theorem-hyps
 ;;                                 instantiated-main-theorem-conclusions
 ;;                                 `(("Goal"
 ;;                                    :use (:instance
 ;;                                          ,main-theorem-name
 ;;                                          ,@(alist-to-doublets param-constant-alist))
 ;;                                    :in-theory (union-theories
 ;;                                                (theory 'executable-counterparts)
 ;;                                                (theory 'minimal-theory))))
 ;;                                 t
 ;;                                 nil
 ;;                                 t
 ;;                                 state)
 ;;                  (if err
 ;;                      (mv :error nil nil dag-array state)
 ;;                    ;;now simplify the conclusion(s) of the instantiated theorem:
 ;;                    ;;fixme do something more general than just dropping nthcdr of 0
 ;;                    ;;fixme what about firstn of 0?
 ;;                    (let* ((simplified-instantiated-main-theorem-conclusions
 ;;                            (replace-nthcdr-0-in-if-nest-list instantiated-main-theorem-conclusions))
 ;;                           (simplified-instantiated-main-theorem-conclusions
 ;;                            (equate-items-to-t-both-ways
 ;;                             simplified-instantiated-main-theorem-conclusions))
 ;;                           (simplified-instantiated-main-theorem-name
 ;;                            (mypackn (list 'simplified-instantiated- main-theorem-name))))
 ;;                      (mv-let
 ;;                       (err state)
 ;;                       ;;fixme - we had (equal (equal ..f.. ..g..) t) but needed the reverse
 ;;                       (my-defthm-fn-rewrite
 ;;                        simplified-instantiated-main-theorem-name
 ;;                        instantiated-main-theorem-hyps
 ;;                        simplified-instantiated-main-theorem-conclusions
 ;; ;what theory should we use here?
 ;;                        `(("Goal"
 ;;                           :use (:instance ,instantiated-main-theorem-name)
 ;;                           :in-theory (disable ,fn1 ,fn2)))
 ;;                        nil
 ;;                        state)
 ;;                       (if err
 ;;                           (mv :error nil nil dag-array state)
 ;;                         ;;ffixme change this to apply the new rule(s) to the miter here but also return them...

 ;;                         ;;we've proved some rules and could try to use them right here, but we prefer to do it at the start of the next call to this function
 ;;                         ;;since the same rule may apply to the two nodes currently under consideration as well as other pairs representing
 ;;                         ;;the other return values of the function
 ;;                         (mv :failed
 ;;                             `(,@(if fn1-tail-recp nil `((:rewrite ,fn1-theorem-name)))
 ;;                               ,@(if fn2-tail-recp nil `((:rewrite ,fn2-theorem-name)))
 ;;                               (:rewrite ,simplified-instantiated-main-theorem-name)
 ;;                               )
 ;; ;do we need the fn1 and fn2 theorems?
 ;;                             nil ;no new fn names are introduced?  (unrolling is done in another case)
 ;;                             dag-array state))))))))))))))))

 ;; Returns (mv erp result analyzed-function-table nodenums-not-to-unroll rand state) where, if ERP is nil, then RESULT is :proved, :timed-out, :failed, or (list :new-rules new-runes new-fn-names) or (list :apply-rule ...)
 ;; at least one node (but not necessarily both) is supported by a recursive function - what if one has several rec fns and the other has one that needs to be split? - what if we can cut out the rec fns, leaving only bv and array fns?
 ;; the rec fns here may be things other than loop functions...
 ;;ffffixme really the "rec" fns include any built-ins other than bv/array/bool operators
 (defun try-to-prove-non-pure-nodes-equal (original-nodenum1 ;the smaller nodenum
                                           original-nodenum2 ;the larger nodenum (can the nodenums be equal?) this node will be replaced
                                           miter-array-name miter-array miter-len
                                           miter-depth
                                           max-conflicts
                                           print interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                           extra-stuff ;does soundness depend on anything in this, or are these just hints?
                                           monitored-symbols
                                           assumptions ;terms we can assume non-nil ; we'd like to add these to the dag earlier, but that may be unsound since DAG nodes get transformed using contexts.
                                           test-cases
                                           test-case-array-alist step-num
                                           analyzed-function-table unroll
                                           some-goal-timed-outp nodenums-not-to-unroll
                                           options
                                           rand state)
   (declare (xargs :guard (and (or (null max-conflicts) (natp max-conflicts))
                               (not (eq 'dag-array miter-array-name)))
                   :mode :program :stobjs (rand state)))
   (b* ((- (cw " Trying to prove non-pure nodes ~x0 and ~x1 equal.~%" original-nodenum1 original-nodenum2))
        ;;Start by trying to rewrite the equality of the two nodes to true:
        ;;often at this point it's just that stuff is commuted wrong - add rules to handle such cases in the first rule set below?
        ;; We can do the rewrite in the context for the node that is being replaced:
        ;; TODO: first try rewriting without this external context? TODO: could just rewrite the equality node?
        ;; TODO: i wonder if the rewrites here are so expensive that we should just rewrite the dag after every merge?
        ;; TODO: delay generating the context until after the first rewrite below (which will handle ifs with constant tests - seems common)
        (context (get-context-for-nodenum original-nodenum2 miter-array-name miter-array miter-len
                                          )) ; todo: compute before the sweep?  how would tranforming the dag affect things?
        (- (cw " (Context for node ~x0: ~x1)~%" original-nodenum2 context))
        ((when (false-contextp context))
         (cw "! Nodes are equal because context is false !")
         (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state))
        ;; TODO: optimize if the context is (true-context)
        (context-nodenums (get-nodenums-mentioned-in-non-false-context context))
        ;;now including the miter name in this name, in case there are nested calls with live context arrays (can that happen?):
        (external-context-array-name (and context-nodenums (pack$ miter-array-name '-external-context-array)))
        ;;To pass the context information into the rewriter, we extract only the stuff that supports the context nodes into the new array context-array:
        ((mv context-array context-array-len translation-array)
         (if context-nodenums
             (extract-dag-array context-nodenums miter-array-name miter-array miter-len external-context-array-name)
           (mv nil nil nil)))
        ;;fixup the context to use the node numbering in context-array:
        (context (and context-nodenums (fixup-non-false-context context 'translation-array translation-array))) ; could drop the context-nodenums text
        ((when (false-contextp context)) ; todo: ensure this can't happen given the false-contextp test above
         (cw "! Nodes are equal because fixed-up context is false !")
         (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state))
        ((mv renamed-smaller-nodenum renamed-larger-nodenum dag-lst)
;fixme: do we really need to rewrite the two nodes themselves, rather than just their equality?  i guess rewriting might commute things consistently.  call something like rewrite-nodenum?
         (drop-non-supporters-array-two-nodes-with-name miter-array-name miter-array original-nodenum1 original-nodenum2) ;fixme or use a worklist?
         )
        ;;often there are ifs supporting the nodes with tests that have been replaced by constants (really?  shouldn't they have been merged with their then or else branches?
        ;;(dummy3 (print-dag-array-node-and-supporters-list (list original-nodenum1 original-nodenum2) miter-array-name miter-array))
        ;;First try to prove the equality using existing lemmas.
        ;;fixme should we do this outside this function? might be expensive!
        ;;ffixme eventually pass the miter-array to the rewriter?? (be careful not to override existing nodes), but for now it has the wrong name
        ;;(dag-len (+ 1 original-nodenum2)) ;only include nodes 0...original-nodenum2
        ;;(dag-array (new-array1 'dag-array dag-len)) ;give it some extra space to grow?
        ;;(dag-array (copy-array-vals original-nodenum2 miter-array-name miter-array 'dag-array dag-array))
        ;;(dag-lst (dag-array-to-dag-lst2 miter-array-name miter-array original-nodenum2)) ;drop this conversion?
        ;;add the equality:
        (dag-lst (acons-fast (+ 1 (top-nodenum dag-lst)) `(equal ,renamed-smaller-nodenum ,renamed-larger-nodenum) dag-lst))
        (- (prog2$ (cw " (Rewriting equality: (~x0 nodes)~%" (+ 1 (top-nodenum dag-lst)))
                   (and print (or (eq t print) (eq :verbose print) (eq :verbose! print)) (print-list dag-lst))))
        (- (and (not rewriter-rule-alist)
                (cw "WARNING: Empty rewriter-rule-alist.~%")))
        ((mv erp simplified-dag-lst state)
         (simp-dag dag-lst ;no longer contains irrelevant nodes
                   :rule-alists
                   (list
                    ;; (make-rule-alist-simple (make-axe-rules (rules-that-throw-stuff-away) ;ffffixme add to this (do ifs with constant tests get handled by the rewriter?)
                    ;;                                           (w state))
                    ;;                              t (table-alist 'axe-rule-priorities-table (w state))
                    ;;                              ) ;start by evaluating constants
                    rewriter-rule-alist ;now excludes the transformer rules (they could be quite expensive (imagine that we have an unroller rule that doesn't fire until a merge that happened below this point in the sweep; it would fire on many or all merges above that point in this sweep) - we probably do want lemmas equating two functions though.
                    )
                   :assumptions assumptions
                   :monitor monitored-symbols
                   :interpreted-function-alist interpreted-function-alist
                   :print print
                   :use-internal-contextsp nil ;trying nil, Tue Mar  8 18:32:40 2011 t ;new
                   :memoizep nil               ;because of internal contexts?
                   :slack-amount (+ 1 original-nodenum2) ;this is more like the initial slack space for the array to grow
                   :context context ; may be nil, in which case the 3 args just below are meaningless
                   :context-array-name external-context-array-name
                   :context-array context-array ;fixme this gets smashed!
                   :context-array-len context-array-len
                   :check-inputs nil))
        ((when erp) (mv erp nil nil nil rand state)))
     (if (quotep simplified-dag-lst)
         (if (equal *t* simplified-dag-lst)
             (prog2$ (cw "Equality rewrote to true!)~%") ;fixme would like to see what rules were used..
                     (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state))
           (if (equal *nil* simplified-dag-lst)
               (prog2$ (cw "Equality rewrote to false!)~%") ;can this happen? would it mean the nodes are never equal?  what about the test cases?
                       (mv (erp-nil) :failed analyzed-function-table nodenums-not-to-unroll rand state))
             (prog2$ (er hard 'try-to-prove-non-pure-nodes-equal
                         "!! ERROR The miter rewrote to a constant other than t or nil, namely ~x0.  This should never happen (unless the hypotheses contradict).)~%"
                         simplified-dag-lst)
                     (mv (erp-t) nil analyzed-function-table nodenums-not-to-unroll rand state))))
       (prog2$
        (and (and print (or (eq t print) (eq :verbose print) (eq :verbose! print)) (print-list dag-lst))
             (prog2$ (cw "Equality rewrote to:~%")
                     (print-list simplified-dag-lst)))
        ;; The equality didn't rewrite to a constant.  Now analyze which recursive functions are involved and where they are.
        (let* ((dummy1 (cw "Done rewriting.)~%"))
               ;;could save consing this up? fixme should this analysis use the simplified-dag-lst ??
               (supporting-nodes1 (supporters-of-node-with-name original-nodenum1 miter-array-name miter-array 'tag-array-for-supporters))
               (supporting-nodes2 (supporters-of-node-with-name original-nodenum2 miter-array-name miter-array 'tag-array-for-supporters))
               (all-relevant-nodes (union-eql-tail supporting-nodes1 supporting-nodes2)) ;could sort both and merge? or don't cons up the lists of nodes at all?
               (rec-fn-nodes-to-handle (filter-rec-fn-nodes-to-handle all-relevant-nodes miter-array-name miter-array state))
               (rec-fn-nodes-to-handle (merge-sort-< rec-fn-nodes-to-handle))
;could use a faster remove that takes advantage of sortedness: (ffixme maybe there can be no dups by this point?)
               (rec-fn-nodes-to-handle (remove-duplicates ;-eql
                                        rec-fn-nodes-to-handle))
               (dummy2 (cw "(Supporting rec. fn. nodes: ~x0.)~%" rec-fn-nodes-to-handle)))
          (declare (ignore dummy1 dummy2))
          (mv-let ;if result here is not :call-prover, we'll just return it as the result:
            (erp result analyzed-function-table nodenums-not-to-unroll rand state)
            (if (not rec-fn-nodes-to-handle)
                ;;We shouldn't generate lemmas, because the only functions are "built-ins" so just call the prover:
                (prog2$
                 (cw "(Proof involves only built-in functions.)~%") ;move the printing of calling prover..
                 ;;ffffixme could cut the proof (to remove rec. fns) and call stp here?
                 (mv (erp-nil) :call-prover analyzed-function-table nodenums-not-to-unroll rand state))
              ;;There is at least "user recursive" function.  Make sure they have all been handled individually: ;fixme will any rec fns ever be unhandled after presimp?
              ;;ffixme should we check for unrolling first?
              (b* (((mv erp analyze-rec-fns-result analyzed-function-table rand state)
                    ;;Generate lemmas about the supporting rec. fns:
                    (analyze-rec-fns rec-fn-nodes-to-handle miter-array-name miter-array interpreted-function-alist extra-stuff
                                     rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table unroll
                                     (+ 1 miter-depth)
                                     monitored-symbols max-conflicts print options rand state))
                   ((when erp) (mv erp nil analyzed-function-table nodenums-not-to-unroll rand state))
                   (new-runes (first analyze-rec-fns-result))
                   (new-fn-names (second analyze-rec-fns-result)))
                (if new-runes
                    ;;if some lemmas were generated about the individual functions,
                    ;;fail this call and try to use them to rewrite the dag
                    ;;ffixme rewrite the miter right here, using the new rules?? - just rewrite the equality??
                    ;;ffixme only fail here if there is a rule that drops params from a function?
                    ;; i.e., if it's just type facts, continue here?
                    ;;what about rules that rewrite an rv?
                    (prog2$ (cw "We proved some lemmas, so this call will fail but the next may succeed.")
                            (mv (erp-nil) (list :new-rules new-runes new-fn-names) analyzed-function-table nodenums-not-to-unroll rand state))

                  ;;All rec. fns. have been handled individually.
                  ;;ffixme should we use the simplified miter dag more below this point? might lose the context?  should we simplify the main dag?
                  ;;do clause mitering? huh?
                  ;;possible strategies left at this point: split a function, unroll a function completely, unroll by a constant factor, convert from head rec to tail rec, prove a lemma to connect two functions, combine a producer and a consumer on the same side into one function, use one function as the spec for the function on the other side (for sequences, assuming we have a rule for a call to nth of the first function), prove two head rec functions equivalent (deprecate), reverse the order in which a sequence is filled (what if there are several seq being filled?), take a function that cdrs down a list and transform it to use nth?

                  ;; Find all the rec fns above the common supporters:
                  (b* ((- (cw "(Didn't prove any lemmas about supporting rec. fns.)~%"))
                       (supporters-array-length (+ 1 original-nodenum2))
                       (node1-supporters-array (tag-supporters-of-node-with-name original-nodenum1 miter-array-name miter-array 'node1-supporters-array supporters-array-length))
                       (node2-supporters-array (tag-supporters-of-node-with-name original-nodenum2 miter-array-name miter-array 'node2-supporters-array supporters-array-length))
                       ;;supporters of node1 that don't support node2:
                       (rec-fn-nodes1 (non-tagged-supporters-with-rec-fns-to-handle original-nodenum1 miter-array-name miter-array 'node2-supporters-array node2-supporters-array state))
                       (rec-fns1 (fns-at-nodes rec-fn-nodes1 miter-array-name miter-array))
                       ;;supporters of node2 that don't support node1:
                       (rec-fn-nodes2 (non-tagged-supporters-with-rec-fns-to-handle original-nodenum2 miter-array-name miter-array 'node1-supporters-array node1-supporters-array state))
                       (rec-fns2 (fns-at-nodes rec-fn-nodes2 miter-array-name miter-array))
                       ;;(all-relevant-fns (union-eq rec-fns1 rec-fns2))
                       (- (prog2$ (cw "(Recursive functions supporting only node 1:~x0)~%" rec-fns1)
                                  (cw "(Recursive functions supporting only node 2:~x0)~%" rec-fns2))))
                    (if (and (not rec-fns1)
                             (not rec-fns2))
                        ;; All the rec fns are in the common supporters (so the loops of the two implementations have been merged below that point)
                        (prog2$ (cw "Neither node has user rec. fns above the merge point.~%")
                                ;;could this ever be very expensive?  maybe if there are lots of ifs to split on?  don't split on ifs in the common supporters?
                                (mv (erp-nil) :call-prover analyzed-function-table nodenums-not-to-unroll rand state))
                      (if (not rec-fns1)
                          ;;ffixme sometimes one node depends on a rec fn but not really
                          ;;ex: (nth 0 (if test (cons x rec-fn-call) (cons w z))) -- i guess splitting the miter would eventually handle this
;ffixme consider the cases where one node depends on the other node (which is a rec fn)?  they manifest themselves here?
                          (prog2$ (cw "(Only node 2 has user rec. fns above the merge point.  Will attempt to completely unroll fns ~x0:~%" rec-fns2)
                                  ;;fixme don't bother if we've already tried and failed to unroll (i guess this will be the case if unroll is :all)
                                  (mv-let (complete-unrolling-result analyzed-function-table nodenums-not-to-unroll state)
                                    (try-to-completely-unroll-rec-fns rec-fn-nodes2 rec-fns2
                                                                      miter-array-name miter-array interpreted-function-alist extra-stuff
                                                                      test-cases test-case-array-alist analyzed-function-table
                                                                      nil nil nodenums-not-to-unroll state)
                                    (prog2$ (cw ")")
                                            (mv (erp-nil)
                                                (if (eq :failed complete-unrolling-result)
                                                    :failed
                                                  (cons :new-rules complete-unrolling-result))
                                                analyzed-function-table nodenums-not-to-unroll rand state))))
                        (if (not rec-fns2)
                            ;;fixme don't bother if we've already tried and failed to unroll (i guess this will be the case if unroll is :all)
                            (prog2$ (cw "(Only node 1 has user rec. fns above the merge point.  Will attempt to completely unroll fns ~x0:~%" rec-fns1)
;could this ever be very expensive?  maybe if there are lots of ifs to split on?  don't split on ifs in the common supporters?
;(mv :call-prover nil nil extra-stuff analyzed-function-table state)
                                    (mv-let (complete-unrolling-result analyzed-function-table nodenums-not-to-unroll state)
                                      (try-to-completely-unroll-rec-fns rec-fn-nodes1 rec-fns1
                                                                        miter-array-name miter-array interpreted-function-alist extra-stuff
                                                                        test-cases test-case-array-alist analyzed-function-table
                                                                        nil nil nodenums-not-to-unroll state)
                                      (prog2$ (cw ")")
                                              (mv (erp-nil)
                                                  (if (eq :failed complete-unrolling-result)
                                                      :failed
                                                    (cons :new-rules complete-unrolling-result))
                                                  analyzed-function-table nodenums-not-to-unroll rand state))))

                          ;;Both nodes have loop functions above the common supporters (could be several on each side; may be hard to synchronize):
                          ;;fffixme think more about what to do here...
                          (prog2$
                           (cw "(Checking for producer/consumer pattern:~%")
                           (mv-let
                             (erp producer-consumer-result state) ; producer-consumer-result is nil or (list new-runes new-fns)
                             (handle-producer-consumer-pattern rec-fn-nodes1 rec-fn-nodes2 miter-array-name miter-array interpreted-function-alist state)
                             (if erp
                                 (mv erp nil analyzed-function-table nil rand state)
                               (if producer-consumer-result
                                   (prog2$ (cw "handled producer/consumer pattern.)")
                                           (mv (erp-nil)
                                               (cons :new-rules producer-consumer-result)
                                               analyzed-function-table nodenums-not-to-unroll rand state))
                                 (prog2$
                                  (cw "No producer/consumer pattern.)~%")
                                  ;; Try to split a loop fn:
                                  (let ((rec-fn-node-to-split (find-rec-fn-node-to-split (append rec-fn-nodes1 rec-fn-nodes2) miter-array-name miter-array extra-stuff)))
                                    ;;fffixme automatically figure out the splits!
                                    ;; (relevant-split-infos (get-split-infos all-relevant-fns extra-stuff))
                                    ;;handle splitting more than one node at a time?
                                    (if rec-fn-node-to-split ;will be nil or (list nodenum fn split-amount)
                                        (prog2$
                                         (cw "Splitting rec fn. ~x0 at node ~x1 using split-amount ~x2.~%"
                                             (second rec-fn-node-to-split)
                                             (first rec-fn-node-to-split)
                                             (third rec-fn-node-to-split))
                                         (mv-let (split-rule-symbol new-fns other-runes state)
                                           (split-tail-function (second rec-fn-node-to-split) state)
                                           (mv (erp-nil)
                                               (list :apply-rule
                                                     split-rule-symbol
                                                     (first rec-fn-node-to-split) ;the nodenum at which to apply the rule
                                                     ;;the alist to use:
                                                     (acons 'split-amount (third rec-fn-node-to-split) nil) ; split-amount should be a term over vars, nodenums, and quoteps
                                                     other-runes new-fns)
                                               analyzed-function-table nodenums-not-to-unroll rand state)))

                                      ;;fffixme automatically figure out the unrolling factors?!
;call something like find-a-fn-to-unroll here (pass it what?)
                                      (let* ((fn1 (first rec-fns1)) ;ffixme what if there is more than one fn?
                                             (fn2 (first rec-fns2)) ;ffixme what if there is more than one fn?
                                             (unrolling-factor1 (g :unrolling-factor (g fn1 extra-stuff)))
                                             (unrolling-factor2 (g :unrolling-factor (g fn2 extra-stuff)))
                                             )
                                        (if unrolling-factor1
                                            (prog2$ (cw ",,(We should unroll ~x0 by a factor of ~x1.~%" fn1 unrolling-factor1)
                                                    (mv-let (unrolled-fn rune state)
                                                      (unroll-function fn1 unrolling-factor1 nil state)
                                                      ;;fixme do peeling and lemma proving of the unrolled function right here?
                                                      (prog2$ (cw ")~%")
                                                              (mv (erp-nil)
                                                                  (list :new-rules (list rune) (list unrolled-fn)) analyzed-function-table nodenums-not-to-unroll
                                                                  rand state))))
                                          (if unrolling-factor2
                                              (prog2$ (cw ",,(We should unroll ~x0 by a factor of ~x1.~%" fn2 unrolling-factor2)
                                                      (mv-let (unrolled-fn rune state)
                                                        (unroll-function fn2 unrolling-factor2 nil state)
                                                        ;;fixme do peeling and lemma proving of the unrolled function right here?
                                                        (prog2$ (cw ")~%")
                                                                (mv (erp-nil)
                                                                    (list :new-rules (list rune) (list unrolled-fn)) analyzed-function-table nodenums-not-to-unroll
                                                                    rand state))))
                                            ;; think more about where the rec fns might be. examine how the rec fns on one side depend on each other?
                                            ;;what if there are several recursive functions between the common supporters and the nodes in question?  might have to split or unroll some
                                            ;;ignore packing functions?
                                            ;;ffixme handle complete unrolling here (even if the number of reps is not constant but is still bounded) ??
                                            (b* ((- (cw "(No splitting or unrolling to do.)~%"))
                                                 ;;strip off any calls to nth, etc., to get the real recursive functions:
                                                 ;;fffixme this stuff is gross: we know from above where the rec fns are?
                                                 ;;fffixme what if there is more than one rec fn on one or both sides?
                                                 (nodenum1 (find-rec-fn original-nodenum1 miter-array-name miter-array))
                                                 (nodenum2 (find-rec-fn original-nodenum2 miter-array-name miter-array))
                                                 (expr1 (aref1 miter-array-name miter-array nodenum1))
                                                 (expr2 (aref1 miter-array-name miter-array nodenum2))
                                                 (fn1 (ffn-symb expr1))
                                                 (fn2 (ffn-symb expr2))
                                                 (- (cw "Analyzing functions ~x0 and ~x1 together.~%" fn1 fn2))) ;print the nodes?
                                              (if (not (and (recursive-functionp fn1 state) ;move one or both checks up? ;check that they are not built-ins?
                                                            (recursive-functionp fn2 state)))
                                                  ;;ffffixme unroll one of them?!
;fffixme is this branch possible? maybe it is
                                                  (prog2$ (cw "both nodes must be rec fns. (FIXME we should unroll one).!~%") ;better msg
                                                          (mv (erp-nil) :failed analyzed-function-table nodenums-not-to-unroll rand state) ;fixme call prover?
                                                          )
                                                (if (member-equal (make-sorted-pair fn1 fn2) (g :analyzed-function-pairs analyzed-function-table)) ;save the nodenums?  does this survive between sweeps?  should it?
                                                    (prog2$ (cw "Already proved a lemma (or tried to) about these two functions together.~%") ;better msg
;fixme try to reverse one of the functions (but not if we've already done it)?
;we could pay attention here to what return values of the functions we are interested in?
                                                            (mv (erp-nil) :call-prover analyzed-function-table nodenums-not-to-unroll rand state))

                                                  (let* ((fn1-tail-recp (tail-recursivep fn1 state)) ;fixme same as fn1-nice-tail-recp? unless it's a fn we can't make simple?
                                                         (fn2-tail-recp (tail-recursivep fn2 state)) ;ditto

                                                         (is-a-nice-tail-function-result1 (is-a-nice-tail-function fn1 state))
                                                         (fn1-nice-tail-recp (first is-a-nice-tail-function-result1))
                                                         (exit-test-expr1 (second is-a-nice-tail-function-result1))
                                                         (base-case-expr1 (third is-a-nice-tail-function-result1))
                                                         (update-expr-list1 (fourth is-a-nice-tail-function-result1))

                                                         (is-a-nice-tail-function-result2 (is-a-nice-tail-function fn2 state))
                                                         (fn2-nice-tail-recp (first is-a-nice-tail-function-result2))
                                                         (exit-test-expr2 (second is-a-nice-tail-function-result2))
                                                         (base-case-expr2 (third is-a-nice-tail-function-result2))
                                                         (update-expr-list2 (fourth is-a-nice-tail-function-result2))

                                                         (args1 (fargs expr1)) ;constants and nodenums
                                                         (args2 (fargs expr2)) ;constants and nodenums
                                                         ;;(arity1 (len args1))
                                                         ;;(arity2 (len args2))
                                                         ) ;;fixme: use the initial values of the args somehow  for type info?
                                                    (cond
                                                     ;;two different RVs of the same recursive function (and we've already analyzed that function)
                                                     ((equal nodenum1 nodenum2)
                                                      (prog2$ (cw "rec fn nodes involved should be different. FAILing.~%")
                                                              (mv (erp-nil) :call-prover analyzed-function-table nodenums-not-to-unroll rand state)))
                                                     ;;only fn1 is tail recursive: ;fixme delete this case
                                                     ((and nil ;!!!!!!! fixme
                                                           fn1-tail-recp
                                                           (not fn2-tail-recp))
                                                      ;;ffixme do we still want to do this? ffixme call the prover here?
                                                      (prog2$ (cw ",,Making head-recursive version of ~x0.~%" fn1)
                                                              (let ((state (submit-events-brief (CONVERT-TO-HEAD-RECURSIVE-EVENTS-wrapper fn1 state) state))) ;fffffixme handle name clashes!
                                                                (mv (erp-nil)
                                                                    (list :new-rules
                                                                          `(,(pack$ fn1 '-becomes- fn1 '-head)
                                                                            ,(pack$ fn1 '-head)
                                                                            ;;,(pack$ fn1 '-base) ;newly removed
                                                                            ,(pack$ fn1 '-reps-when-not-exit))
                                                                          ;;anything else?
                                                                          (list (pack$ fn1 '-head-aux)
                                                                                (pack$ fn1 '-head)
                                                                                (pack$ fn1 '-reps)))
                                                                    analyzed-function-table nodenums-not-to-unroll
                                                                    rand state))))
                                                     ;; ffixme call the prover here?
                                                     ;;only fn2 is tail recursive: ;fixme delete this case
                                                     ((and nil ;!!!!!!! fixme
                                                           fn2-tail-recp
                                                           (not fn1-tail-recp))
                                                      ;;ffixme do we still want to do this?
                                                      (prog2$ (cw ",,Making head-recursive version of ~x0.~%" fn2)
                                                              (let ((state (submit-events-brief (CONVERT-TO-HEAD-RECURSIVE-EVENTS-wrapper fn2 state) state)))
                                                                (mv (erp-nil)
                                                                    (list :new-rules
                                                                          `(,(pack$ fn2 '-BECOMES- fn2 '-HEAD)
                                                                            ,(pack$ fn2 '-head)
                                                                            ;;,(pack$ fn2 '-base) newly-removed
                                                                            ,(pack$ fn2 '-reps-when-not-exit))
                                                                          ;;anything else?
                                                                          (list (pack$ fn2 '-head-aux)
                                                                                (pack$ fn2 '-head)
                                                                                (pack$ fn2 '-reps)))
                                                                    analyzed-function-table nodenums-not-to-unroll
                                                                    rand state))))
                                                     ((not (and fn1-tail-recp
                                                                fn2-tail-recp))
                                                      ;;one is head rec.  fixme print something?!
                                                      (mv (erp-nil) :call-prover analyzed-function-table nodenums-not-to-unroll rand state))
                                                     (t
                                                      (b* ((- (cw ",,Trying to connect the functions ~x0 and ~x1 (either both head-rec or both tail-rec).~%" fn1 fn2))
                                                           ;;reuse the traces we found when analyzing the functions individually (may have been in a previous miter)?
                                                           ;;fixme do we somewhere make sure there are at least 2 test cases?
                                                           (traces-pair
                                                            (get-traces-for-two-nodes nodenum1 nodenum2 miter-array-name miter-array interpreted-function-alist
                                                                                      test-cases test-case-array-alist))
                                                           (traces1 (first traces-pair))
                                                           (traces2 (second traces-pair))
                                                           (traces1 (flatten-traces traces1))
                                                           (traces2 (flatten-traces traces2))
                                                           (trace-lens1 (len-list traces1))
                                                           (trace-lens2 (len-list traces2))
                                                           (call-counts1 (sub1-list trace-lens1)) ;don't count the base cases
                                                           (call-counts2 (sub1-list trace-lens2)) ;don't count the base cases
                                                           (- (progn$ (cw "(Call counts for ~x0:~%~y1.)~%(Call counts for ~x2:~%~y3.)~%" fn1 call-counts1 fn2 call-counts2)
                                                                      (cw "first few traces for ~x0:~%" fn1)
                                                                      (if (and print (not (eq :brief print))) (print-list (firstn 3 traces1)) (cw ":elided~%"))
                                                                      (cw "first few traces for ~x0:~%" fn2)
                                                                      (if (and print (not (eq :brief print))) (print-list (firstn 3 traces2)) (cw ":elided~%"))))

                                                           ;;what if the traces have different lengths?!
                                                           (fn1-real-calls (car call-counts1))
                                                           (fn2-real-calls (car call-counts2))

                                                           ;;fixme if all traces aren't the same length, check that the unrolling factor works on the other traces?
                                                           ;;fixme use our pattern finding stuff to figure out the unrolling or peeling off factors?
                                                           ;;fixme what if they both have to be unrolled?
                                                           ;;ffffixme unrolling is also done above
                                                           ;;fixme unrolling may be needed to expose the nodes that match (e.g., if there are a remainder of iterations that dont match anything)
                                                           ;;this is gross?
                                                           (unrolling-factor1 (if (zp fn2-real-calls) :none (/ fn1-real-calls fn2-real-calls)))
                                                           (unrolling-factor1 (or (g :unrolling-factor (g fn1 extra-stuff)) unrolling-factor1))
                                                           (unrolling-factor2 (if (zp fn1-real-calls) :none (/ fn2-real-calls fn1-real-calls)))
                                                           (unrolling-factor2 (or (g :unrolling-factor (g fn2 extra-stuff)) unrolling-factor2)))
                                                        (cond
                                                         ;;Unroll function 1: (fixme mark the pair as handled after this?)
                                                         ((and (integerp unrolling-factor1)
                                                               (< 1 unrolling-factor1))
                                                          (prog2$ (cw ",,(We should unroll ~x0 by a factor of ~x1.~%" fn1 unrolling-factor1)
                                                                  (mv-let (unrolled-fn rune state)
                                                                    (unroll-function fn1 unrolling-factor1 nil state)
                                                                    ;;fixme do peeling and lemma proving of the unrolled function right here?
                                                                    (prog2$ (cw ")~%")
                                                                            (mv (erp-nil)
                                                                                (list :new-rules (list rune) (list unrolled-fn)) analyzed-function-table nodenums-not-to-unroll
                                                                                rand state)))))
                                                         ;;Unroll function 2: (fixme mark the pair as handled after this?)
                                                         ((and (integerp unrolling-factor2)
                                                               (< 1 unrolling-factor2))
                                                          (prog2$ (cw ",,(We should unroll ~x0 by a factor of ~x1.~%" fn2 unrolling-factor2)
                                                                  (mv-let (unrolled-fn rune state)
                                                                    (unroll-function fn2 unrolling-factor2 nil state)
                                                                    ;;fixme do peeling and lemma proving of the unrolled function right here?
                                                                    (prog2$ (cw ")~%")
                                                                            (mv (erp-nil)
                                                                                (list :new-rules (list rune) (list unrolled-fn)) analyzed-function-table nodenums-not-to-unroll
                                                                                rand state)))))
                                                         ;;fixme what if they both should be unrolled?
                                                         (t
                                                          (prog2$
                                                           (cw "No unrolling to do.~%")
                                                           (if (and fn1-nice-tail-recp fn2-nice-tail-recp)
                                                               (mv-let
                                                                 (erp new-runes new-fn-names rand state)
                                                                 (generate-connection-lemma-for-nice-tail-rec-fns
                                                                  fn1 exit-test-expr1 base-case-expr1 update-expr-list1 traces1 args1
                                                                  fn2 exit-test-expr2 base-case-expr2 update-expr-list2 traces2 args2
                                                                  max-conflicts
                                                                  rewriter-rule-alist
                                                                  prover-rule-alist extra-stuff interpreted-function-alist
                                                                  (+ 1 miter-depth)
                                                                  print monitored-symbols
                                                                  analyzed-function-table
                                                                  unroll options
                                                                  rand state)
                                                                 (if erp
                                                                     (mv erp nil nil nil rand state)
;ffixme what if no connections were found? still good to mark the pair as analyzed, i guess..
                                                                   (mv (erp-nil)
                                                                       (list :new-rules new-runes new-fn-names)
;fixme should this go in analyzed-function-table?
                                                                       (s :analyzed-function-pairs
                                                                          (cons (make-sorted-pair fn1 fn2)
                                                                                (g :analyzed-function-pairs analyzed-function-table))
                                                                          analyzed-function-table)
                                                                       nodenums-not-to-unroll rand state)))
                                                             ;;both head rec?  is this stuff out of date? pull out this stuff into a subroutine..
                                                             (prog2$
                                                              (hard-error 'try-to-prove-non-pure-nodes-equal "don't yet support this case." nil)
                                                              (mv (erp-t) nil analyzed-function-table nodenums-not-to-unroll rand state))

                                                             ;;                                                                  (let*
                                                             ;;                                                                      ((dummy0 (prog2$ (hard-error 'try-to-prove-non-pure-nodes-equal "don't yet support this case." nil)
                                                             ;;                                                                                       (cw "Generating lemma for non-nice-tail-rec functions ~x0 and ~x1.~%" fn1 fn2)))
                                                             ;;                                                                       ;;fffixme:
                                                             ;;                                                                       ;; (dummy2a (if (eq 'REDUCE-PROCESS-BLOCK fn1) (cw "The first 3 traces for ~x0: ~x1" fn1 (firstn 3 traces1)) nil))
                                                             ;;                                                                       ;; (dummy2b (if (eq 'REDUCE-PROCESS-BLOCK fn1) (cw "The first 3 traces for ~x0: ~x1" fn2 (firstn 3 traces2)) nil))
                                                             ;;                                                                       (original-formals1 (fn-formals fn1 (w state)))
                                                             ;;                                                                       (original-formals2 (fn-formals fn2 (w state)))
                                                             ;; ;we prepend 'f' and 'g' to the formals of the functions to prevent any name clashes:
                                                             ;;                                                                       (prefix-for-fn1 (if (symbol< fn1 fn2) 'f 'g)) ;new
                                                             ;;                                                                       (prefix-for-fn2 (if (symbol< fn1 fn2) 'g 'f)) ;new
                                                             ;;                                                                       (formals1 (mypackn-list (cons-onto-all prefix-for-fn1 (enlist-all original-formals1))))
                                                             ;;                                                                       (formals2 (mypackn-list (cons-onto-all prefix-for-fn2 (enlist-all original-formals2))))
                                                             ;;                                                                       (function-call-term1 `(,fn1 ,@formals1))
                                                             ;;                                                                       (function-call-term2 `(,fn2 ,@formals2))
                                                             ;;                                                                       ;;ffixme we may have already done a lot of the analysis below when trying to simplify the rv of the fn...
                                                             ;;                                                                       (dummy1 (cw "Function call 1: ~x0~%" function-call-term1))
                                                             ;;                                                                       (dummy2 (cw "Function call 2: ~x0~%" function-call-term2))
                                                             ;; ;each element is the trace-list for a given argument?
                                                             ;; ;use these more below!
                                                             ;;                                                                       (args-traces1 (g-list-list :args traces1))
                                                             ;;                                                                       (args-traces2 (g-list-list :args traces2))
                                                             ;;                                                                       (return-value-traces1 (g-list-list :return-value traces1))
                                                             ;;                                                                       (return-value-traces2 (g-list-list :return-value traces2))

                                                             ;;                                                                       ;; Generate hyps about fn1:
                                                             ;;                                                                       (hyps1 (try-to-find-hyps args-traces1 arity1 formals1 fn1))
                                                             ;;                                                                       ;; (dummy10 (cw "Hyps1: ~x0" hyps1))
                                                             ;;                                                                       (rv-type-facts1 (make-type-facts-for-rv return-value-traces1 function-call-term1 ;;-with-hide
                                                             ;;                                                                                                               ))
                                                             ;;                                                                       (rv-equalities1 (try-to-express-rv-with-params return-value-traces1 args-traces1
                                                             ;;                                                                                                                      function-call-term1 ;;-with-hide
                                                             ;;                                                                                                                      arity1 formals1))
                                                             ;;                                                                       ;; Generate hyps about fn2:
                                                             ;;                                                                       (hyps2 (try-to-find-hyps args-traces2 arity2 formals2 fn2))
                                                             ;;                                                                       ;;(dummy11 (cw "Hyps2: ~x0" hyps2))
                                                             ;;                                                                       (rv-type-facts2 (make-type-facts-for-rv return-value-traces2 function-call-term2 ;;-with-hide
                                                             ;;                                                                                                               ))
                                                             ;;                                                                       (rv-equalities2 (try-to-express-rv-with-params return-value-traces2 args-traces2
                                                             ;;                                                                                                                      function-call-term2 ;;-with-hide
                                                             ;;                                                                                                                      arity2 formals2))
                                                             ;;                                                                       ;;these are about both functions (should we allow params of the other function too?)
                                                             ;;                                                                       ;;do we not want this for tail-rec functions?
                                                             ;; ;fffixme go both ways here?:
                                                             ;;                                                                       (dummy3 (cw ",,Finding cross rv equalities:~%"))
                                                             ;;                                                                       (main-theorem-concs
                                                             ;;                                                                        (assert-non-nil
                                                             ;;                                                                         'main-theorem-concs (try-to-express-rv-with-rvs-and-params
                                                             ;;                                                                                              function-call-term1 ;;-with-hide
                                                             ;;                                                                                              traces1
                                                             ;;                                                                                              function-call-term2 ;;-with-hide
                                                             ;;                                                                                              traces2 arity2 formals2)))


                                                             ;; ;fixme - if we equated a g param with an f param there's no need to generate type hyps for both of them...
                                                             ;; ;fixme, which function should we rewrite to the other?
                                                             ;; ;fixme - should we try to express g's params in terms of f's?  since we can then substitute into the expression of f in terms of g?

                                                             ;;                                                                       (connections1
                                                             ;;                                                                        (try-to-express-params-with-params args-traces1 arity1 formals1
                                                             ;;                                                                                                           args-traces2 arity2 formals2))
                                                             ;;                                                                       ;;for tail rec. fns we can't capture this information with lemmas about the RVs of each
                                                             ;;                                                                       ;;function separately:
                                                             ;;                                                                       (connections2
                                                             ;;                                                                        (if fn1-tail-recp
                                                             ;;                                                                            (try-to-express-params-with-params args-traces2 arity2 formals2
                                                             ;;                                                                                                               args-traces1 arity1 formals1)
                                                             ;;                                                                          nil))
                                                             ;; ;fffixme we may have some equalities both ways!

                                                             ;;                                                                       (fn-with-connections (if (symbol< fn1 fn2) fn1 fn2))
                                                             ;;                                                                       (extra-connections (g :connections (g fn-with-connections extra-stuff))) ;can these mention old vars?
                                                             ;;                                                                       (connections (append extra-connections connections1 connections2))

                                                             ;;                                                                       (dummy4 (progn$ (cw "connections1: ~x0~%" connections1)
                                                             ;;                                                                                       (cw "connections2: ~x0~%" connections2)
                                                             ;;                                                                                       (cw "user-supplied connections: ~x0~%" extra-connections)))

                                                             ;; ;we should consider dropping assertions about hyps that we know are constants?
                                                             ;; ;eg is x is always 4 and y is always a list of length 3 - we'd get that x=1+len(y)
                                                             ;;                                                                       (hyps (remove-duplicates-equal (append connections hyps1 hyps2)))
                                                             ;;                                                                       (dummy5 (cw ",,Hyps are: ~x0" hyps))
                                                             ;; ;fixme, try proving each conjunct separately?
                                                             ;; ;now we prove facts about f and g's return values separately when possible.

                                                             ;; ;fixme, make sure the calls to equal in the conclusion have args in the right order
                                                             ;; ;fixme, only include info about return values we care about?
                                                             ;; ;fixme, skip this if we are pre-simplifying?
                                                             ;;                                                                       (fn1-theorem-name (pack$ 'generated-theorem-for-function- fn1))
                                                             ;;                                                                       (fn2-theorem-name (pack$ 'generated-theorem-for-function- fn2))
                                                             ;;                                                                       (main-theorem-name (pack$ 'equivalence-of- fn1 '-and- fn2))
                                                             ;; ;we don't check for errors here - okay?
                                                             ;;                                                                       (hide-opener-name1 (pack$ fn1 '-hide-opener '-for-comparison))
                                                             ;;                                                                       (hide-dropper-name1 (pack$ fn1 '-hide-dropper '-for-comparison))
                                                             ;;                                                                       (hide-opener-name2 (pack$ fn2 '-hide-opener '-for-comparison))
                                                             ;;                                                                       (hide-dropper-name2 (pack$ fn2 '-hide-dropper '-for-comparison))
                                                             ;;                                                                       ;;do we still need the hide stuff if we are disabling the definitions of the functions?
                                                             ;;                                                                       (state (make-hide-opener-and-dropper fn1 formals1 use-axe-proverp
                                                             ;;                                                                                                            hide-opener-name1 hide-dropper-name1 state))
                                                             ;;                                                                       (state (make-hide-opener-and-dropper fn2 formals2 use-axe-proverp
                                                             ;;                                                                                                            hide-opener-name2 hide-dropper-name2 state))
                                                             ;;                                                                       (induction-fn-name (pack$ 'joint-induct- fn1 '-and- fn2))
                                                             ;; ;what does this do?

                                                             ;;                                                                       ;;(hyps (refine-hyps main-theorem-name hyps extra-stuff (append formals1 formals2))) ;drop?
                                                             ;;                                                                       (main-theorem-concs (append (get-extra-concs main-theorem-name extra-stuff) main-theorem-concs))
                                                             ;; ;avoid doing this unless we need to?
                                                             ;; ;ffixme what about values for the old vars??
                                                             ;;                                                                       (test-cases-for-formals1 (make-test-cases-for-formals formals1 args-traces1))
                                                             ;;                                                                       (test-cases-for-formals2 (make-test-cases-for-formals formals2 args-traces2))
                                                             ;;                                                                       (test-cases-for-formals (append-list
                                                             ;;                                                                                                test-cases-for-formals1
                                                             ;;                                                                                                test-cases-for-formals2)))
                                                             ;;                                                                    (declare (ignore dummy0 dummy1 dummy2 dummy3 dummy4 dummy5))
                                                             ;;                                                                    (mv-let
                                                             ;;                                                                     (err result state)
                                                             ;;                                                                     ;;abuse of progn for only 1 event?
                                                             ;;                                                                     (progn-fn (list (make-induction-function fn1 fn2 induction-fn-name state)) state)
                                                             ;;                                                                     (declare (ignore err result))
                                                             ;;                                                                     (mv-let
                                                             ;;                                                                      (err state)
                                                             ;;                                                                      (if fn1-tail-recp
                                                             ;;                                                                          (mv nil state) ;don't do it for tail-rec functions
                                                             ;;                                                                        ;;ffixme don't spend time generating rv-equalities1 and rv-type-facts1 !
                                                             ;; ;fixme, what if it can't be made into a good rule (e.g., no conjuncts?)
                                                             ;;                                                                        (my-defthm-fn-rewrite-with-and-without-hides
                                                             ;;                                                                         (list function-call-term1)
                                                             ;;                                                                         fn1-theorem-name
                                                             ;;                                                                         (refine-hyps fn1 hyps1 extra-stuff formals1)
                                                             ;;                                                                         (append (get-extra-concs fn1 extra-stuff)
                                                             ;;                                                                                 (conclusion-conjuncts
                                                             ;;                                                                                  rv-type-facts1
                                                             ;;                                                                                  rv-equalities1))
                                                             ;; ;fixme use minimal theory?
                                                             ;;                                                                         `(("Goal" :do-not '(generalize eliminate-destructors)
                                                             ;;                                                                            :in-theory (e/d ((:induction ,fn1))
                                                             ;;                                                                                            ((:definition ,fn1)))
                                                             ;;                                                                            :induct ,function-call-term1)
                                                             ;;                                                                           ,@(if use-axe-proverp
                                                             ;;                                                                                 `((if STABLE-UNDER-SIMPLIFICATIONP
                                                             ;;                                                                                       '(:clause-processor
                                                             ;;                                                                                         (axe-prover
                                                             ;;                                                                                          clause
                                                             ;;                                                                                          ',(s :goal-name fn1-theorem-name
                                                             ;;                                                                                               (axe-prover-hints
                                                             ;;                                                                                                `((:nil ,hide-opener-name1)
                                                             ;;                                                                                                  (:nil ,hide-dropper-name1))
                                                             ;;                                                                                                (empty-rule-alist) ;fffixme which rules to use?
                                                             ;;                                                                                                interpreted-function-alist
                                                             ;;                                                                                                (firstn 200 test-cases-for-formals1) ;ffixme
                                                             ;;                                                                                                analyzed-function-table
                                                             ;;                                                                                                ))
                                                             ;;                                                                                          state))
                                                             ;;                                                                                     nil))
                                                             ;;                                                                               nil))
                                                             ;;                                                                         state))
                                                             ;;                                                                      (if err
                                                             ;;                                                                          (mv :error extra-stuff analyzed-function-table state)
                                                             ;;                                                                        (mv-let
                                                             ;;                                                                         (err state)
                                                             ;;                                                                         (if fn2-tail-recp
                                                             ;;                                                                             (mv nil state) ;don't do it for tail-rec functions
                                                             ;;                                                                           ;;fixme use the -rewrite version above - any only when appropriate
                                                             ;;                                                                           (my-defthm-fn-rewrite-with-and-without-hides
                                                             ;;                                                                            (list function-call-term2)
                                                             ;;                                                                            fn2-theorem-name
                                                             ;;                                                                            (refine-hyps fn2 hyps2 extra-stuff formals2)
                                                             ;;                                                                            (append
                                                             ;;                                                                             (get-extra-concs fn2 extra-stuff)
                                                             ;;                                                                             (conclusion-conjuncts
                                                             ;;                                                                              rv-type-facts2
                                                             ;;                                                                              rv-equalities2))
                                                             ;;                                                                            `(("Goal" :do-not '(generalize eliminate-destructors)
                                                             ;;                                                                               :in-theory (e/d ((:induction ,fn2))
                                                             ;;                                                                                               ((:definition ,fn2)))
                                                             ;;                                                                               :induct ,function-call-term2)
                                                             ;;                                                                              ,@(if use-axe-proverp
                                                             ;;                                                                                    `((if STABLE-UNDER-SIMPLIFICATIONP
                                                             ;;                                                                                          '(:clause-processor
                                                             ;;                                                                                            (axe-prover
                                                             ;;                                                                                             clause
                                                             ;;                                                                                             ',(s :goal-name fn2-theorem-name
                                                             ;;                                                                                                  (axe-prover-hints
                                                             ;;                                                                                                   `((:nil ,hide-opener-name2)
                                                             ;;                                                                                                     (:nil ,hide-dropper-name2))
                                                             ;;                                                                                                   nil ;;ffixme which rules to use?
                                                             ;;                                                                                                   interpreted-function-alist
                                                             ;;                                                                                                   (firstn 200 test-cases-for-formals2) ;ffixme
                                                             ;;                                                                                                   analyzed-function-table
                                                             ;;                                                                                                   ))
                                                             ;;                                                                                             state))
                                                             ;;                                                                                        nil))
                                                             ;;                                                                                  nil))
                                                             ;;                                                                            state))
                                                             ;;                                                                         (if err
                                                             ;;                                                                             (mv :error extra-stuff analyzed-function-table state)
                                                             ;;                                                                           (mv-let
                                                             ;;                                                                            (err state)
                                                             ;;                                                                            (if (endp main-theorem-concs)
                                                             ;;                                                                                (mv (prog2$ (hard-error 'try-to-prove-non-pure-nodes-equal
                                                             ;;                                                                                                        "No conclusions found"
                                                             ;;                                                                                                        nil)
                                                             ;;                                                                                            t)
                                                             ;;                                                                                    state)
                                                             ;;                                                                              ;; Main theorem:
                                                             ;;                                                                              (my-defthm-fn-rewrite-with-and-without-hides ;don't need rewrite here?
                                                             ;;                                                                               (list function-call-term1 function-call-term2)
                                                             ;;                                                                               main-theorem-name
                                                             ;;                                                                               hyps
                                                             ;;                                                                               main-theorem-concs
                                                             ;;                                                                               `(("Goal" :do-not '(generalize eliminate-destructors)
                                                             ;;                                                                                  :in-theory ;; (e/d ((:induction ,fn1)
                                                             ;;                                                                                  ;;                                                                    (:induction ,fn2)
                                                             ;;                                                                                  ;;                                                                    ;;ffixme if they disagree on being tail-rec
                                                             ;;                                                                                  ;;                                                                    ;;we have big problems
                                                             ;;                                                                                  ;;                                                                    ,@(if fn1-tail-recp nil (list fn1-theorem-name))
                                                             ;;                                                                                  ;;                                                                    ,@(if fn2-tail-recp nil (list fn2-theorem-name)))
                                                             ;;                                                                                  ;;                                                                   ((:definition ,fn1)
                                                             ;;                                                                                  ;;                                                                    (:definition ,fn2)))
                                                             ;;                                                                                  (union-theories (theory 'minimal-theory)
                                                             ;;                                                                                                  '((:induction ,induction-fn-name)
                                                             ;;                                                                                                    ;;ffixme if they disagree on being tail-rec
                                                             ;;                                                                                                    ;;we have big problems
                                                             ;;                                                                                                    ,@(if fn1-tail-recp nil (list fn1-theorem-name))
                                                             ;;                                                                                                    ,@(if fn2-tail-recp nil (list fn2-theorem-name))))
                                                             ;;                                                                                  :induct (,induction-fn-name
                                                             ;;                                                                                           ,@formals1
                                                             ;;                                                                                           ,@formals2))
                                                             ;;                                                                                 ,@(if use-axe-proverp
                                                             ;;                                                                                       `((if STABLE-UNDER-SIMPLIFICATIONP
                                                             ;;                                                                                             '(:clause-processor
                                                             ;;                                                                                               (axe-prover
                                                             ;;                                                                                                clause
                                                             ;;                                                                                                ',(s :goal-name main-theorem-name
                                                             ;;                                                                                                     (s :print t
                                                             ;;                                                                                                        (axe-prover-hints
                                                             ;;                                                                                                         (append (if fn1-tail-recp nil (list `(:rewrite ,fn1-theorem-name)))
                                                             ;;                                                                                                                 (if fn2-tail-recp nil (list `(:rewrite ,fn2-theorem-name)))
                                                             ;;                                                                                                                 `((:nil ,hide-opener-name1)
                                                             ;;                                                                                                                   (:nil ,hide-dropper-name1)
                                                             ;;                                                                                                                   (:nil ,hide-opener-name2)
                                                             ;;                                                                                                                   (:nil ,hide-dropper-name2)))
                                                             ;;                                                                                                         prover-rule-alist ;;was nil
                                                             ;;                                                                                                         interpreted-function-alist
                                                             ;;                                                                                                         (firstn 200 test-cases-for-formals) ;ffixme
                                                             ;;                                                                                                         analyzed-function-table
                                                             ;;                                                                                                         )))
                                                             ;;                                                                                                state))
                                                             ;;                                                                                           nil))
                                                             ;;                                                                                     nil))
                                                             ;;                                                                               state))
                                                             ;;                                                                            (if err
                                                             ;;                                                                                (mv :error extra-stuff analyzed-function-table state)
                                                             ;;                                                                              ;;we proved the theorem but might need to specialize it (e.g., if contains (nthcdr n x) where n evaluates to 0 on the initial function arguments
                                                             ;;                                                                              (let*
                                                             ;;                                                                                  ((f1-param-constant-alist (make-param-constant-alist formals1 args1))
                                                             ;;                                                                                   (f2-param-constant-alist (make-param-constant-alist formals2 args2))
                                                             ;;                                                                                   (param-constant-alist (append f1-param-constant-alist
                                                             ;;                                                                                                                 f2-param-constant-alist))
                                                             ;;                                                                                   (instantiated-main-theorem-hyps
                                                             ;;                                                                                    (sublis-var-and-eval-lst2 param-constant-alist hyps nil))
                                                             ;;                                                                                   ;;fixme consider passing in some functions?
                                                             ;;                                                                                   (instantiated-main-theorem-conclusions
                                                             ;;                                                                                    (sublis-var-and-eval-lst2 param-constant-alist
                                                             ;;                                                                                                                main-theorem-concs nil))
                                                             ;;                                                                                   (instantiated-main-theorem-conclusions
                                                             ;;                                                                                    (remove-hides-lst instantiated-main-theorem-conclusions))
                                                             ;;                                                                                   (instantiated-main-theorem-hyps
                                                             ;;                                                                                    (remove-hides-lst instantiated-main-theorem-hyps))
                                                             ;;                                                                                   (instantiated-main-theorem-name
                                                             ;;                                                                                    (mypackn (list 'instantiated- main-theorem-name))))
                                                             ;;                                                                                (mv-let
                                                             ;;                                                                                 (err state)
                                                             ;;                                                                                 (my-defthm-fn2 instantiated-main-theorem-name
                                                             ;;                                                                                                instantiated-main-theorem-hyps
                                                             ;;                                                                                                instantiated-main-theorem-conclusions
                                                             ;;                                                                                                `(("Goal"
                                                             ;;                                                                                                   :use (:instance
                                                             ;;                                                                                                         ,main-theorem-name
                                                             ;;                                                                                                         ,@(alist-to-doublets param-constant-alist))
                                                             ;;                                                                                                   :in-theory (union-theories
                                                             ;;                                                                                                               (executable-counterparts)
                                                             ;;                                                                                                               (theory 'minimal-theory))))
                                                             ;;                                                                                                t
                                                             ;;                                                                                                nil
                                                             ;;                                                                                                t
                                                             ;;                                                                                                state)
                                                             ;;                                                                                 (if err
                                                             ;;                                                                                     (mv :error extra-stuff analyzed-function-table state)
                                                             ;;                                                                                   ;;now simplify the conclusion(s) of the instantiated theorem:
                                                             ;;                                                                                   ;;fixme do something more general than just dropping nthcdr of 0
                                                             ;;                                                                                   ;;fixme what about firstn of 0?
                                                             ;;                                                                                   (let* ((simplified-instantiated-main-theorem-conclusions
                                                             ;;                                                                                           (replace-nthcdr-0-in-if-nest-list instantiated-main-theorem-conclusions))
                                                             ;;                                                                                          (simplified-instantiated-main-theorem-conclusions
                                                             ;;                                                                                           (equate-items-to-t-both-ways
                                                             ;;                                                                                            simplified-instantiated-main-theorem-conclusions))
                                                             ;;                                                                                          (simplified-instantiated-main-theorem-name
                                                             ;;                                                                                           (mypackn (list 'simplified-instantiated- main-theorem-name))))
                                                             ;;                                                                                     (mv-let
                                                             ;;                                                                                      (err state)
                                                             ;;                                                                                      ;;fixme - we had (equal (equal ..f.. ..g..) t) but needed the reverse
                                                             ;;                                                                                      (my-defthm-fn-rewrite
                                                             ;;                                                                                       simplified-instantiated-main-theorem-name
                                                             ;;                                                                                       (wrap-all 'work-hard instantiated-main-theorem-hyps)
                                                             ;;                                                                                       simplified-instantiated-main-theorem-conclusions
                                                             ;;                                                                                       ;;fffffixme what theory should we use here?
                                                             ;;                                                                                       `(("Goal"
                                                             ;;                                                                                          :use (:instance ,instantiated-main-theorem-name)
                                                             ;;                                                                                          :in-theory (e/d (work-hard) (,fn1 ,fn2))))
                                                             ;;                                                                                       nil
                                                             ;;                                                                                       state)
                                                             ;;                                                                                      (if err
                                                             ;;                                                                                          (mv :error extra-stuff analyzed-function-table state)
                                                             ;;                                                                                        ;;ffixme change this to apply the new rule(s) to the miter here but also return them...

                                                             ;;                                                                                        ;;we've proved some rules and could try to use them right here, but we prefer to do it at the start of the next call to this function
                                                             ;;                                                                                        ;;since the same rule may apply to the two nodes currently under consideration as well as other pairs representing
                                                             ;;                                                                                        ;;the other return values of the function
                                                             ;;                                                                                        (mv (list :new-rules
                                                             ;;                                                                                                  `(,@(if fn1-tail-recp nil `((:rewrite ,fn1-theorem-name)))
                                                             ;;                                                                                                    ,@(if fn2-tail-recp nil `((:rewrite ,fn2-theorem-name)))
                                                             ;;                                                                                                    (:rewrite ,simplified-instantiated-main-theorem-name)
                                                             ;;                                                                                                    )
                                                             ;; ;do we need the fn1 and fn2 theorems?
                                                             ;;                                                                                                  nil) ;no new fn names are introduced?  (unrolling is done in another case)
                                                             ;;                                                                                            extra-stuff analyzed-function-table state)))))))))))))))
                                                             ))))))))))))))))))))))))))))
            (if erp
                (mv erp nil analyzed-function-table nodenums-not-to-unroll rand state)
              (if (eq :call-prover result)
                  (b* ((case-name (concatenate 'string "depth" (nat-to-string miter-depth) "step" (nat-to-string step-num) "-"))
                       ;;ffixme could cut out the common stuff when calling the prover?  or the rewriter (above)?
                       (- (cw "(Calling DAG prover for ~s0 (dag len ~x1, print ~x2):~%" case-name (len simplified-dag-lst) print))
                       ;;(cw "(~x0 monitored rules)" (len monitored-symbols))
                       (- (and (not prover-rule-alist)
                               (cw "WARNING: Empty prover-rule-alist.~%"))))
                    (mv-let (erp result state)
                      ;;might be nice to get an array above and pass it straight to the prover here:
                      (prove-dag-with-axe-prover simplified-dag-lst
                                                 assumptions ;these are terms
                                                 (list prover-rule-alist)
                                                 interpreted-function-alist monitored-symbols
                                                 print case-name
                                                 context ;;nil ;;tried nil for speed but that left out some important stuff
                                                 external-context-array-name ;fixme is this still live?
                                                 context-array
                                                 context-array-len
                                                 max-conflicts
                                                 (not some-goal-timed-outp) ; print-max-conflicts-goalp
                                                 nil ;options
                                                 state)
                      (if erp
                          (mv erp nil analyzed-function-table nodenums-not-to-unroll rand state)
                        (if (eq :proved result)
                            (prog2$ (cw "Prover rewrote the clause to true!)~%")
                                    (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state))
                          (if (eq :timed-out result)
                              (prog2$ (cw "Prover failed (by reaching the max conflict limit) to prove the clause.)~%")
                                      (mv (erp-nil) :timed-out analyzed-function-table nodenums-not-to-unroll rand state))
                            (prog2$ (cw "Prover failed to prove the clause.)~%")
                                    (mv (erp-nil) :failed analyzed-function-table nodenums-not-to-unroll rand state)))))))
                (if (eq :error result)
                    (prog2$ (er hard 'try-to-prove-non-pure-nodes-equal "Unexpected error.") ; impossible?
                            (mv (erp-t) nil analyzed-function-table nodenums-not-to-unroll rand state))
                  (mv (erp-nil) result analyzed-function-table nodenums-not-to-unroll rand state))))))))))

 ;; Tries to prove the equivalence of SMALLER-NODENUM and LARGER-NODENUM in MITER-ARRAY.
 ;; fixme could the two nodenums ever be the same? maybe not...
 ;; Returns (mv erp result analyzed-function-table nodenums-not-to-unroll rand state) where, if ERP is nil, then RESULT is :proved, :timed-out, :error, :failed, or (list :new-rules new-runes new-fn-names) or (list :apply-rule ...)
 (defun try-to-prove-nodes-equal (smaller-nodenum
                                  larger-nodenum
                                  miter-array-name miter-array miter-len
                                  miter-depth ;fixme track the actual names of the theorems we are trying to prove?
                                  var-type-alist
                                  print interpreted-function-alist
                                  rewriter-rule-alist prover-rule-alist extra-stuff
                                  monitored-symbols
                                  assumptions ;terms to assume non-nil
                                  test-cases test-case-array-alist
                                  step-num ;use this even in the pure case?
                                  analyzed-function-table unroll miter-is-purep
                                  some-goal-timed-outp max-conflicts miter-name nodenums-not-to-unroll
                                  options
                                  rand state)
   (declare (xargs :guard (and (natp smaller-nodenum)
                               (< smaller-nodenum miter-len)
                               (natp larger-nodenum)
                               (< larger-nodenum miter-len)
                               (pseudo-dag-arrayp miter-array-name miter-array miter-len)
                               (natp miter-depth)
                               (var-type-alistp var-type-alist)
                               (print-levelp print)
                               (interpreted-function-alistp interpreted-function-alist)
                               (rule-alistp rewriter-rule-alist)
                               (rule-alistp prover-rule-alist)
                               (extra-stuff-okayp extra-stuff)
                               (symbol-listp monitored-symbols)
                               (pseudo-term-listp assumptions)
                               ;; ...more...
                               (or (null max-conflicts) (natp max-conflicts))
                               (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (b* (;; First, we check whether the nodes are calls of the same function on the same arguments (may be quite common):
        (expr1 (aref1 miter-array-name miter-array smaller-nodenum))
        (expr2 (aref1 miter-array-name miter-array larger-nodenum))
        ((when (identical-dag-exprs-up-to-constant-inlining expr1 expr2 miter-array-name miter-array miter-len))
         (and print (cw "  Structural equivalence between ~x0 and ~x1.~%" smaller-nodenum larger-nodenum))
         (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state))
        ;; Special case: Check for xor nests with the same leaves (above the shared nodes) -- may be very common:
        ;; TODO: Also handle bvxor!
        ((when (and (not (variablep expr1))
                    (not (variablep expr2))
                    (eq 'bitxor (ffn-symb expr1))
                    (eq 'bitxor (ffn-symb expr2))
                    ;; could optimize a bit since we know the nodes are bitxors?:
                    (identical-bitxor-nestsp (list smaller-nodenum) (list larger-nodenum) 0 0 miter-array-name miter-array miter-len)))
         (and print (cw "  Bitxor equivalence between ~x0 and ~x1.~%" smaller-nodenum larger-nodenum))
         (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state)))
     ;; Next, determine whether everything relevant is pure:
     ;;ffixme also check that all necessary indices and sizes are constants (miter-is-purep could reflect that? maybe it does now?)
     (if (and (or miter-is-purep ; common
                  ;; TODO: Instead of this, consider pre-computing which nodes are pure (updating that info when merging nodes):
                  (both-nodes-are-purep smaller-nodenum larger-nodenum miter-array-name miter-array var-type-alist)
                  )
              ;;could omit non pure assumptions (but then the proof may fail)?
              (if (pure-assumptionsp assumptions) ;; TODO: don't recompute this each time ;; TODO: We could drop or cut non-pure ones.
                  t
                (prog2$ (cw "WARNING: Not treating equality of nodes ~x0 and ~x1 as pure due to the presence of assumptions.~%" smaller-nodenum larger-nodenum)
                        nil)))
         ;; The relevant part of the miter is pure:
         ;;should we first make a miter and rewrite it?   pull that code up out of try-to-prove-non-pure-nodes-equal? no?  might be expensive?
         ;; or just rewrite the top node?
         (mv-let (success-flg state) ;ffixme handle errors?
           ;;fffixme pass in and translate assumptions?  they may be tighter than the sizes that are apparent from how the variables are used?
           ;; TTODO: use (pure) contexts!
           (try-to-prove-pure-nodes-equal smaller-nodenum larger-nodenum miter-array-name miter-array miter-len var-type-alist print max-conflicts miter-name state)
           (if success-flg
               (mv (erp-nil) :proved analyzed-function-table nodenums-not-to-unroll rand state)
             ;; fixme would like to get a counterexample back and use it try to invalidate more "probable facts":
             (mv (erp-nil) :failed analyzed-function-table nodenums-not-to-unroll rand state)))
       ;; TODO: What if we could cut and then get a pure miter?  maybe we should always cut out the non-pure stuff and try it! but then try the non-pure approach too...
       ;; fixme should we check for and expand any remining user non-recursive functions?
       (try-to-prove-non-pure-nodes-equal smaller-nodenum larger-nodenum miter-array-name miter-array miter-len
                                          miter-depth max-conflicts
                                          print interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                          extra-stuff monitored-symbols
                                          assumptions test-cases test-case-array-alist step-num analyzed-function-table unroll
                                          some-goal-timed-outp nodenums-not-to-unroll options rand state)))) ;fixme pass in miter-name?

 ;;       (if cut-proofs
 ;;           (mv-let (erp result miter-array state)
 ;;                   (try-aggressively-cut-equivalence-proof nodenum1
 ;;                                                  nodenum2
 ;;                                                  miter-array
 ;;                                                  miter-len
 ;;                                                  var-type-alist
 ;;
 ;; print
 ;;                                                  state)
 ;;                   (declare (ignore erp))
 ;;                   (if result
 ;;                       (mv t miter-array state)
 ;;                     ;; if the cut proof failed, try the whole proof:
 ;;                     (mv-let (erp result miter-array state)
 ;;                             (attempt-full-equivalence-proof nodenum1
 ;;                                                             nodenum2
 ;;                                                             miter-array
 ;;                                                             miter-len
 ;;                                                             var-size-alist
 ;;                                                             print
 ;;                                                             state)
 ;;                             (declare (ignore erp))
 ;;                             (if result
 ;;                                 (mv t miter-array state)
 ;;                               (mv
 ;;                                (hard-error 'try-to-prove-nodes- equivalent
 ;;                                            "STP failed to prove the equality of nodes ~x0 and ~x1.~%"
 ;;                                            (acons #\0 nodenum1 (acons #\1 nodenum2 nil)))
 ;;                                miter-array
 ;;                                state)))))

 ;;         ;; if cut-proofs is nil, just attempt the whole proof
 ;;         (mv-let (erp result miter-array state)
 ;;                 (attempt-full-equivalence-proof nodenum1
 ;;                                                 nodenum2
 ;;                                                 miter-array
 ;;                                                 miter-len
 ;;                                                 var-size-alist
 ;;                                                 print
 ;;                                                 state)
 ;;                 (declare (ignore erp))
 ;;                 (if result
 ;;                     (mv t miter-array state)
 ;;                   (mv
 ;;                    (hard-error 'try-to-prove-nodes- equivalent
 ;;                                "STP failed to prove the equality of nodes ~x0 and ~x1.~%"
 ;;                                (acons #\0 nodenum1 (acons #\1 nodenum2 nil)))
 ;;                    miter-array
 ;;                    state))))

 ;; Returns (mv erp result miter-array analyzed-function-table nodenums-not-to-unroll rand state), where if ERP is nil, then RESULT is :proved (we proved it and merged), :timed-out, :failed, (list :new-rules new-runes new-fn-names), or (list :apply-rule ...)
 ;;remember failures and failures due to max-conflicts so we don't try them again?
;first generate a proof obligation that smaller-nodenum and larger-nodenum in the graph are equal.
;then change references to the nodes to point instead to the minimum node from the set that contains smaller-nodenum and larger-nodenum
;BOZO now we can't drop repeats of the "same" proof...
;should we skip trivial equivalences?
 (defun try-to-prove-nodes-equal-and-merge (smaller-nodenum
                                            larger-nodenum
                                            miter-array-name miter-array miter-len
                                            miter-depth
                                            var-type-alist ;parent-array-name parent-array
                                            print interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                            extra-stuff monitored-symbols
                                            assumptions test-cases test-case-array-alist step-num analyzed-function-table unroll miter-is-purep
                                            some-goal-timed-outp max-conflicts miter-name nodenums-not-to-unroll options rand state)
   (declare (xargs :guard (and  ;...
                            (or (null max-conflicts) (natp max-conflicts))
                            (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (b* ((- (and (member-eq print '(t :verbose :verbose!)) ;used to print this even for :brief:
                (prog2$ (cw "  Equating nodes ~x0 and ~x1.~%" smaller-nodenum larger-nodenum)
                        ;; we show the simplified miter - that should contain everything interesting from the dag
                        (print-dag-array-nodes-and-supporters miter-array-name miter-array miter-len (list smaller-nodenum larger-nodenum)))))
;fixme finish this.  the point was not to merge two nodes of different array types - but get-type-of-nodenum may sometimes give unfortunate errors here.
;could look at how the two nodes are used.  if they are not used as arrays (or equated to arrays?) then it's okay to merge them?
        ;; (let* ((smaller-node-type (get-type-of-nodenum smaller-nodenum miter-array-name miter-array
        ;;                         nodenum-type-alist ;for cut nodes (esp. those that are not bv expressions) ;now includes true input vars (or do we always cut at a var?)!
        ;;                         )
        ((mv erp result analyzed-function-table nodenums-not-to-unroll rand state)
         (try-to-prove-nodes-equal smaller-nodenum larger-nodenum miter-array-name miter-array miter-len miter-depth var-type-alist
                                   print interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                   extra-stuff monitored-symbols
                                   assumptions test-cases test-case-array-alist step-num analyzed-function-table unroll miter-is-purep
                                   some-goal-timed-outp max-conflicts miter-name nodenums-not-to-unroll options rand state))
        ((when erp) (mv erp nil nil nil nil rand state))
        ((when (eq result :error)) (mv (erp-t) nil nil nil nil rand state)) ; todo: drop once impossible
        )
     (if (eq result :proved)
         ;;replace larger-nodenum with smaller-nodenum in place:
         ;;fixme encapsulate this pattern into a function call?
         (let ((miter-array ;parent-array
                (replace-node-in-parents larger-nodenum smaller-nodenum miter-array-name miter-array ;parent-array-name parent-array
                              miter-len)))
           (prog2$ (cw "  Merging node ~x0 and node ~x1." smaller-nodenum larger-nodenum)
                   (mv (erp-nil)
                       :proved
;ffixme should we rewrite the dag here?
;replace mentions of larger-nodenum with mentions of smaller-nodenum (ffixme which should we choose as the representative? choosing the larger node could cause a violation of the array numbering property)  what if one is nth and the other is bv-array-read?  obviously if one is a supporter of the other, choose the supporter..
                       ;;                                     (change-mentions-of-nodenum (+ 1 larger-nodenum) ;only look at nodes that might mention larger-nodenum
                       ;;                                                                 ;;special case when min-node is one of the nodenums in question (will often be the case)
                       ;;                                                                 miter-len
                       ;;                                                                 larger-nodenum
                       ;;                                                                 smaller-nodenum
                       ;;                                                                 miter-array-name
                       ;;                                                                 miter-array)
                       miter-array analyzed-function-table nodenums-not-to-unroll rand state)))
       (if (or (eq result :failed)
               (eq result :timed-out))
           ;;if the equivalence proof fails, report that fact, don't merge the nodes, and continue
           (prog2$ (cw "!! We failed to prove the equality of nodes ~x0 and ~x1.!!~% Not merging.~%" smaller-nodenum larger-nodenum)
                   (mv (erp-nil)
                       result miter-array ;parent-array
                       analyzed-function-table nodenums-not-to-unroll rand state))
         ;; result is (list :new-rules ...) or (list :apply-rule ...)
         (prog2$ (cw "!! We failed to prove the equality of nodes ~x0 and ~x1.!!~% Not merging, but we did generate some rules.~%" smaller-nodenum larger-nodenum)
                 (mv (erp-nil)
                     result miter-array ;parent-array
                     analyzed-function-table nodenums-not-to-unroll rand state))))))

 ;; Tries to prove that NODENUM in MITER-ARRAY is always equal to the constant CONSTANT-VALUE, given the ASSUMPTIONS and the context provided by the IFs in MITER-ARRAY above NODENUM.
 ;; May generate lemmas about recursive functions that support NODENUM.
 ;; Returns (mv erp result analyzed-function-table rand state) where if ERP is nil, then RESULT is either :proved, :failed, :timed-out, or (list :new-rules new-runes new-fn-names)
 (defun try-to-prove-node-is-constant (constant-value ;not quoted
                                       nodenum
                                       expr ;the expr at nodenum, which is known not to be a quotep
                                       miter-array-name miter-array miter-len
                                       var-type-alist print
                                       interpreted-function-alist extra-stuff
                                       rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist
                                       assumptions ; terms we can assume non-nil
                                       monitored-symbols step-num analyzed-function-table miter-depth unroll miter-is-purep
                                       use-proverp-flag some-goal-timed-outp max-conflicts miter-name options rand state)
   (declare (xargs :guard (and ;...
                            (or (null max-conflicts) (natp max-conflicts))
                            (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (b* ((- (cw "  Trying to prove node ~x0 is the constant ~x1.~%" nodenum constant-value)) ;add parens?
        ;;check for trivial equality (this helps if we had (equal x y) and x
        ;;has since been replaced by y; we'll now have (equal y y). fixme what
        ;;about (equal x <const>)?? unfortunately we are not replacing the
        ;;const in the parents yet?):
        ((when (and (eq t constant-value)
                    (eq 'equal (ffn-symb expr))
                    (equal (farg1 expr)
                           (farg2 expr))))
         (cw "  Trivial equality.~%")
         (mv (erp-nil) :proved analyzed-function-table rand state)))
     ;; todo: check for ground term (ex: (booland 't 't))
     ;; Not a trivial equality:
     (if (and (or miter-is-purep
                  (node-is-purep nodenum miter-array-name miter-array var-type-alist))
              ;; todo: check the constant (but it would be odd for a pure node to be probably-equal to a bad constant)?
              (if (pure-assumptionsp assumptions) ;todo: precompute and thread through?  split into pure-assumptions and non-pure-assumptions?
                  t
                (prog2$ (cw "WARNING: Not treating node ~x0 as pure due to the presence of assumptions.~%" nodenum)
                        nil)))
         ;; Pure node:
         (mv-let (erp provedp state)
           (try-to-prove-pure-node-is-constant constant-value nodenum miter-array-name miter-array miter-len var-type-alist print
                                               ;; interpreted-function-alist rewriter-rule-alist assumptions monitored-symbols
                                               max-conflicts miter-name state)
           (if erp
               (mv erp nil analyzed-function-table rand state)
             (if provedp
                 (mv (erp-nil) :proved analyzed-function-table rand state)
               (mv (erp-nil) :failed analyzed-function-table rand state))))
       ;; Non-pure mode (rewrite fully, using contexts, then call the axe-prover, then handle supporting rec. fns):
       ;;fixme can we just call the prover?
;ffixme what if we can cut out the non-bv functions and then hit the dag with stp (maybe with a max-conflicts)?
       ;;fixme for two nodes, don't we analyze rec fns first and then call the prover?
       (b* (;; First simplify the equality of the node and the constant:  FFIXME first rewrite (and maybe call the prover) without using external contexts..
            (- (cw "(Making the equality and rewriting:~%"))
;ffixme if rewriting or proving ends in a goal that is clearly not valid then stop right there?
            ;; This may be slow:
            (context (get-context-for-nodenum nodenum miter-array-name miter-array miter-len))
            (- (cw " (Context for node ~x0: ~x1)~%" nodenum context))
            ((when (false-contextp context))
             (cw "! Proof succeeded due to contradictory context ! )")
             (mv (erp-nil) :proved analyzed-function-table rand state))
            (context-nodenums (get-nodenums-mentioned-in-non-false-context context))
            ;;To pass the context information into the rewriter, we extract only
            ;;the stuff that supports the context nodes into the new array assumptions-array:
            ((mv assumptions-array assumptions-array-len translation-array)
             (if context-nodenums
                 (extract-dag-array context-nodenums miter-array-name miter-array miter-len 'assumptions-array) ; fixme could there be nested calls with live assumptions-arrays? if so, might need to include the depth in this
               (mv nil 0 nil)))
            ;;Fix up the context to mention the right nodes in assumptions-array:
            (context (and context-nodenums (fixup-non-false-context context 'translation-array translation-array))) ; could drop the context-nodenums text
            ((when (false-contextp context)) ; todo: ensure this can't happen, given the false-contextp check above
             (cw "! Proof succeeded due to contradictory fixed-up context ! )")
             (mv (erp-nil) :proved analyzed-function-table rand state))
            ;;ffixme eventually drop the conversion and pass the miter-array to the rewriter (but don't overwrite any existing nodes)??
            ;;  for now the rewriter can only work on an array named 'dag-array
            (dag-lst (drop-non-supporters-array-with-name miter-array-name miter-array nodenum nil))
            (dag-len (len dag-lst)) ;just use top nodenum?
            ;;add the equality:
            (dag-lst (acons-fast dag-len `(equal ,(top-nodenum dag-lst) ',constant-value) dag-lst))
            ;;ffixme should we use contexts here (same question for the analogous call for two probably-equal nodes)?
            ;;fixme option to turn this off?
            (- (and (not rewriter-rule-alist)
                    (cw "WARNING: Empty rewriter-rule-alist.~%")))
            ((mv erp simplified-dag-lst state)
             (simp-dag dag-lst
                       :rule-alists
                       (list ;;phase 1 is quick:
                         ;; (make-rule-alist-simple (make-axe-rules (rules-that-throw-stuff-away) (w state))
                         ;;                         t (table-alist 'axe-rule-priorities-table (w state)))
                         rewriter-rule-alist)
                       :print print
                       :assumptions assumptions ;do these get oriented right?
                       :slack-amount dag-len ; the initial slack space for the array to grow
                       :interpreted-function-alist interpreted-function-alist
                       :use-internal-contextsp t ;Tue Jan 26 03:19:43 2010 ;is this crucial?
                       :memoizep nil ;Tue Jan 26 03:19:43 2010 - ffixme ;maybe don't do it on the first pass, which is supposed to be fast
;ffixme add the option of passing in a list of flags for use-internal-contextsp, one for each rule set.. we already do a rewrite without internal contexts first...
                       :context context
                       :context-array-name 'assumptions-array ; meaningless if context is nil
                       :context-array assumptions-array ; meaningless if context is nil
                       :context-array-len assumptions-array-len ; meaningless if context is nil
                       :check-inputs nil))
            ((when erp) (mv erp nil nil rand state)))
         (if (quotep simplified-dag-lst)
             (if (equal *t* simplified-dag-lst)
                 (prog2$ (cw "  The equality rewrote to true, which proves that node ~x0 is the constant ~x1).~%"
                             nodenum constant-value)
                         (mv (erp-nil) :proved analyzed-function-table rand state))
               (if (equal *nil* simplified-dag-lst)
                   (prog2$ (cw "  !! The equality rewrote to false. We have failed to prove that node ~x0 is the constant ~x1).~%"
                               nodenum constant-value)
                           (mv (erp-nil) :failed analyzed-function-table rand state))
                 (prog2$
                   (hard-error 'try-to-prove-node-is-constant
                               "!! ERROR The equality rewrote to a constant other than t or nil, namely ~x0.  This should never happen (unless your assumptions contradict))."
                               (acons #\0 simplified-dag-lst nil))
                   (mv (erp-t) nil analyzed-function-table rand state))))
           ;;The equality didn't rewrite to a constant, so call the axe-prover:
           (b* ((- (and (eq t print)
                        (prog2$ (cw "Equality rewrote to:~%")
                                (print-list simplified-dag-lst))))
                (- (cw ")~%"))
                (case-name (concatenate 'string "depth" (nat-to-string miter-depth) "step" (nat-to-string step-num) "-"))
                (- (and (not prover-rule-alist)
                    (cw "WARNING: Empty prover-rule-alist.~%")))
                ((mv erp prover-result state)
                 (if use-proverp-flag
                     (prog2$
                       (cw "(Calling Axe Prover for ~s0 (dag len ~x1, print ~x2):~%" case-name (len simplified-dag-lst) print)
                       ;; This rewrites all the assumptions (and the context) too?
                       ;;fixme pass in miter name? for creating the temp file names?
                       (prove-dag-with-axe-prover simplified-dag-lst
                                                  assumptions ;these are terms we can assume non-nil
                                                  (list prover-rule-alist)
                                                  interpreted-function-alist monitored-symbols
                                                  print case-name
                                                  context
                                                  'assumptions-array ; these 3 args are meaningless if context is nil
                                                  assumptions-array ;ffffffixme this may be changed under the hood by the rewrite, giving a slow array warning..?! is it even sound?  now i think it's okay because prove-dag-with-axe-prover doesn't seem to trash the context-array it is passed.
                                                  assumptions-array-len
                                                  max-conflicts
                                                  (not some-goal-timed-outp) ;print-max-conflicts-goalp
                                                  nil ;options
                                                  state))
                   (prog2$ (cw "(Not calling prover because use-proverp-flag is nil.~%")
                           (mv (erp-nil) :failed state))))
                ((when erp) (mv erp nil analyzed-function-table rand state)))
             (if (eq :proved prover-result)
                 (prog2$ (cw "Proved it!)")
                         (mv (erp-nil) :proved analyzed-function-table rand state)) ;could we ever want to return some rules or fns?
               ;;Prove lemmas about supporting rec fns (if any): should we analyze the simplified dag for this (nodenum would not be the right node to use then)?
               ;;ffffffixme move this up????
               (b* ((- (cw "Axe Prover failed)~%")) ;fixme don't say the prover failed if we didnt call it
                    ;;precompute the result for the whole dag? ;only cons up the nodes that have rec fn supporters?
                    (supporters-of-node (supporters-of-node-with-name nodenum miter-array-name miter-array 'tag-array-for-supporters))
                    (nodes-with-rec-fns (filter-rec-fn-nodes-to-handle supporters-of-node miter-array-name miter-array state))
                    ;;move these next 2 down?
                    (nodes-with-rec-fns (merge-sort-< nodes-with-rec-fns))
;could use a faster remove-duplicates that takes advantage of sortedness:
                    (nodes-with-rec-fns (remove-duplicates ;-eql
                                          nodes-with-rec-fns))
                    (- (cw "Supporting rec. fn. nodes: ~x0.~%" nodes-with-rec-fns)))
                 (if (and (not (if nil ;(g :treat-as-purep options)
                                   (prog2$ (cw "NOTE: We have been instructed to treat the miter as pure.~%") t) nil))
                          nodes-with-rec-fns)
                     ;;ffixme what if we have already handled all the nodes?  this can loop??
                     (mv-let (erp result analyzed-function-table rand state) ;;where result is (list new-runes new-fns)
;ffixme what does this do if we have already analyzed those rec fns?:
                       (analyze-rec-fns nodes-with-rec-fns miter-array-name miter-array interpreted-function-alist extra-stuff
                                        rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table unroll
                                        (+ 1 miter-depth)
                                        monitored-symbols max-conflicts print options rand state)
                       (if erp
                           (mv erp nil analyzed-function-table rand state)
                         (if (first result)
                             (mv (erp-nil) (list :new-rules (first result) (second result)) analyzed-function-table rand state)
                           ;;check that we generated something?  or might analyze-rec-fns return non-new runes and fns?
                           ;;ffixme should we try to use the generated fns right here?
                           (mv (erp-nil)
                               prover-result ;;will be :failed or :timed-out
                               analyzed-function-table rand state))))
                   (mv (erp-nil) prover-result ;will be :failed or :timed-out
                       analyzed-function-table rand state))))))))))

 ;; Returns (mv erp result miter-array analyzed-function-table rand state),
 ;; where if ERP is nil, then RESULT is either :proved (we proved it and replaced the node), :failed or :timed-out (we didn't replace the node), or (list :new-rules new-runes new-fn-names)
 ;;ffixme in the :ok cases should we be able to return stuff too? huh?
 (defun try-to-prove-node-is-constant-and-replace (nodenum
                                                   constant-value ;(not quoted)
                                                   miter-array-name miter-array miter-len miter-depth
                                                   var-type-alist ;for translation to STP?
                                                   print interpreted-function-alist
                                                   extra-stuff rewriter-rule-alist prover-rule-alist test-cases
                                                   test-case-array-alist ;parent-array-name parent-array
                                                   assumptions monitored-symbols step-num
                                                   analyzed-function-table unroll miter-is-purep
                                                   use-proverp-flag some-goal-timed-outp max-conflicts miter-name options rand state)
   (declare (xargs :guard (and ;...
                            (or (null max-conflicts) (natp max-conflicts))
                            (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (if (eq :unused constant-value)
       ;; todo: get rid of this check if it never fires
       (prog2$ (er hard 'try-to-prove-node-is-constant-and-replace "unused node.") ;(cw "  (Skipping node ~x0 because it is unused on any test case.)" nodenum) ;fixme now this should never happen?
               (mv (erp-t) nil miter-array analyzed-function-table rand state)) ;fffffixme think about this
     (prog2$ (and (or (eq print 't) (eq print :verbose) (eq print :verbose!))
                  (cw "  Trying to replace node ~x0 with the constant ~x1.~%" nodenum constant-value))
             (let ((expr (aref1 miter-array-name miter-array nodenum)))
               (if (quotep expr)
                   ;; If expr is already a quotep, just check whether it's the expected constant (this might happen if we change Axe to propagate constants up the DAG after merging).
                   (if (equal (unquote expr) constant-value)
                       (prog2$ (cw "Trivial constant equivalence.~%")
                               (mv (erp-nil) :proved miter-array analyzed-function-table rand state))
                     ;;this should never happen:
                     (prog2$ (hard-error 'try-to-prove-node-is-constant-and-replace "Expected one constant but got another!" nil)
                             (mv (erp-t) nil miter-array analyzed-function-table rand state)))
                 (mv-let (erp result analyzed-function-table rand state)
                   (try-to-prove-node-is-constant constant-value nodenum expr miter-array-name miter-array miter-len var-type-alist
                                                  print interpreted-function-alist extra-stuff
                                                  rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist assumptions monitored-symbols step-num
                                                  analyzed-function-table miter-depth unroll miter-is-purep
                                                  use-proverp-flag some-goal-timed-outp max-conflicts miter-name options rand state)
                   (if erp
                       (mv erp nil miter-array analyzed-function-table rand state)
                     (if (eq :proved result) ;may also return runes and fns?
                         ;;proof succeeded, so replace the node:
                         (prog2$ (cw "  Proof succeeded.  Merging node ~x0 with the constant ~x1." nodenum constant-value)
                                 (mv (erp-nil)
                                     :proved
                                     ;; should we replace each mention of the node with the constant? could do it quickly using the parent-array - could propagate constants up the dag...
                                     ;; probably not needed.  hell, we could resimplify the whole dag each time...
                                     ;;could call replace-node-in-parents here but i'd rather add support for propagating the constants up...
                                     (aset1-safe miter-array-name miter-array nodenum (enquote constant-value)) ;fixme could it be that if we don't fixup the parents here we'll do it over and over when rewriting to merge nodes?
                                     ;;the newly-constant node no longer has children:
                                     ;; (if (consp expr) ;checks that it's not a variable (we know from above that it's not a quotep)
                                     ;;     (drop-parent-relationships nodenum (fargs expr) parent-array-name parent-array)
                                     ;;   parent-array)
                                     analyzed-function-table rand state))
                       ;;result must be :failed, :timed-out, or (list :new-rules new-runes new-fns)
                       (prog2$ (cw "!! Proof failed !!  Not merging node ~x0 with constant ~x1." nodenum constant-value)
                               (if (consp result)
                                   (prog2$ (cw "Did generate rules and/or fns though.")
                                           (mv (erp-nil) result miter-array analyzed-function-table rand state))
                                 (mv (erp-nil) result miter-array analyzed-function-table rand state)))))))))))

 ;; Sweeps up the miter, proving and merging nodes (with other nodes or constants) until it reaches the top node or handles a loop fn (generating some lemmas and/or functions). -- fixme, if they are just type lemmas, no need to abort the sweep and use them to simplify the miter? maybe they'd fire...
 ;;FFFIXME if the lemma rewrites the equality of 2 functions, no need abort the sweep and simplify the dag with it?  but keep it around to handle other rvs of the functions?
 ;;what should this do if there are no test cases? that is checked upstream?
 ;;do we need both top-node and miter-len?
 ;; Returns (mv erp result miter-array analyzed-function-table rand state), where if ERP is nil, then RESULT is :proved-miter, :did-nothing, :did-something, or (list :new-rules new-runes new-fn-names) or (list :apply-rule ...)
 ;; if the top node is reached and nothing was merged, result is :did-nothing
 ;; if the top node is reached and something was merged, but the top node wasn't proved true, result is :did-something, meaning simplify (to use the merged stuff and sweep again)
 ;; Result can also be a cons whose car is :new-rules or :apply-rule.
 (defun perform-miter-sweep-aux (next-nodenum-to-consider ;think about this
                                 changep miter-array-name miter-array miter-len miter-depth
                                 sweep-array ; for choosing the next node to attack
                                 ;;parent-array-name parent-array
                                 var-type-alist top-node print debug-nodes interpreted-function-alist
                                 rewriter-rule-alist prover-rule-alist
                                 extra-stuff monitored-symbols assumptions
                                 test-cases test-case-array-alist sweep-num
                                 step-num total-steps
                                 analyzed-function-table
                                 unroll miter-is-purep
                                 nodes-to-not-use-prover-for ;the booland nodes at the top of the miter; don't waste time on them by calling the prover
                                 some-goal-timed-outp max-conflicts miter-name nodenums-not-to-unroll
                                 options
                                 rand state)
   (declare (xargs :guard (and (or (null max-conflicts) (natp max-conflicts))
                               (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (if (equal *t* (aref1 miter-array-name miter-array top-node)) ; stop when the top node has been replaced with 't
       ;;bozo put in some checks here?  maybe not, since we already made sure the top node is all t's
       (prog2$ (cw "Done replacing nodes.  The miter has been reduced to TRUE!~%")
               (mv (erp-nil) :proved-miter miter-array analyzed-function-table rand state))
     (b* ((- (cw "(Depth ~x0 / sweep ~x1 / step ~x2 of ~~~x3:~%" miter-depth sweep-num step-num total-steps))
          ;;(nodenum-with-bad-parents (find-nodenum-with-bad-parents (+ -1 miter-len) parent-array-name parent-array)) ;fixme remove this stuff - it's for debugging
          ;; (if nodenum-with-bad-parents
          ;;     (prog2$
          ;;      (hard-error 'perform-miter-sweep- aux "bad parent lists for ~x0: ~x1."
          ;;                  (acons #\0 nodenum-with-bad-parents (acons #\1 (aref1 'parent-array-name parent-array nodenum-with-bad-parents) nil)))
          ;;      (mv :error miter-array analyzed-function-table rand state))
          ;;Find a node to replace:
          ((mv nodenum-to-replace probably-constantp other-val ;the quoted constant or smaller nodenum it's probably-equal to
               )
           (find-a-node-to-replace next-nodenum-to-consider sweep-array miter-len)))
       (if (not (integerp nodenum-to-replace))
           (if changep ;print the dag?
               (prog2$ (cw "!! couldn't find any node to replace but something changed on this sweep.)")
                       (mv (erp-nil) :did-something miter-array analyzed-function-table rand state))
             (prog2$ (cw "!! couldn't find any node to replace and nothing changed on this sweep !!)")
                     (mv (erp-nil) :did-nothing miter-array analyzed-function-table rand state)))
         ;;We found a node to replace:
         (b* ((- (and (member nodenum-to-replace debug-nodes) ;do we ever use this?
                      (prog2$ (cw "DAG:~%")
                              (print-dag-array-node-and-supporters miter-array-name miter-array (+ -1 miter-len)))))
              (use-proverp-flag (not (member nodenum-to-replace nodes-to-not-use-prover-for))))
           (if probably-constantp
               ;; The node is a probable constant:
               (b* ((constant-value (unquote other-val))
                    ((mv erp result miter-array analyzed-function-table rand state)
                     (if (and (not (g :prove-constants options))
                              (not (eql top-node nodenum-to-replace)) ;always try to prove the top node is T.
                              )
                         (prog2$ (cw "Skipping probable constant node ~x0 since :prove-constants is nil.~%" nodenum-to-replace)
                                 (mv (erp-nil) :failed miter-array analyzed-function-table rand state))
                       (try-to-prove-node-is-constant-and-replace nodenum-to-replace constant-value
                                                                  miter-array-name miter-array miter-len miter-depth
                                                                  var-type-alist print interpreted-function-alist
                                                                  extra-stuff rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist
                                                                  ;;parent-array-name parent-array
                                                                  assumptions monitored-symbols
                                                                  step-num analyzed-function-table unroll miter-is-purep
                                                                  use-proverp-flag some-goal-timed-outp max-conflicts miter-name options rand state)))
                    ((when erp) (mv erp nil miter-array analyzed-function-table rand state))
                    (- (cw ")~%")))
                 (if (or (eq :proved result) (eq :failed result) (eq :timed-out result))
                     ;; Usual case:
                     (let* ((provedp (eq :proved result)) ; :timed-out is treated the same as :failed
                            (sweep-array (if provedp
                                            (update-tags-for-proved-constant-node nodenum-to-replace sweep-array)
                                          (update-tags-for-failed-constant-node nodenum-to-replace sweep-array)))
                            ;; could abort the sweep and simplify the dag right here, but that would change the node numbering...
                            )
                       ;;continue sweeping:
                       (perform-miter-sweep-aux (if provedp (+ 1 nodenum-to-replace) nodenum-to-replace) ; next nodenum to consider
                                                (or changep provedp)
                                                miter-array-name
                                                miter-array miter-len miter-depth
                                                sweep-array
                                                ;;parent-array-name parent-array
                                                var-type-alist top-node print
                                                debug-nodes interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                                extra-stuff monitored-symbols assumptions test-cases
                                                test-case-array-alist sweep-num (+ 1 step-num) total-steps
                                                analyzed-function-table
                                                unroll miter-is-purep nodes-to-not-use-prover-for
                                                (or some-goal-timed-outp
                                                    (eq :timed-out result))
                                                max-conflicts miter-name nodenums-not-to-unroll options
                                                rand state))
                   ;; Otherwise, result is (list :new-rules new-runes new-fn-names) or (list :apply-rule ...)
                   ;; Abort the sweep:
                   (mv (erp-nil) result miter-array analyzed-function-table rand state)))
             ;; This node is the larger nodenum of a probably-equal node pair (and other-val is the smaller nodenum):
             ;;fixme i hope smaller-nodenum and larger-nodenum are guaranteed to be different (what if one has already been merged with another node?)
             (b* ((- (cw " Trying to merge nodes ~x0 and ~x1.~%" nodenum-to-replace other-val))
                  ;;fixme do some analysis here
                  ;;does smaller-nodenum support larger-nodenum?
                  ;;are they both return values of the same recursive function node?
                  ;;we do this analysis elsewhere?
                  ((mv erp result miter-array analyzed-function-table nodenums-not-to-unroll rand state)
                   (try-to-prove-nodes-equal-and-merge
                    other-val          ;;the smaller nodenum
                    nodenum-to-replace ;;the larger nodenum
                    miter-array-name miter-array miter-len miter-depth var-type-alist
;parent-array-name parent-array
                    print interpreted-function-alist rewriter-rule-alist prover-rule-alist
                    extra-stuff monitored-symbols assumptions
                    test-cases test-case-array-alist step-num analyzed-function-table unroll
                    miter-is-purep
                    some-goal-timed-outp max-conflicts miter-name nodenums-not-to-unroll options rand state))
                  ((when erp) (mv erp nil miter-array analyzed-function-table rand state))
                  (- (cw ")~%"))
                  ((when (eq :error result)) ;todo: do we want the paren printed in this case?
                   (mv (erp-t) nil miter-array analyzed-function-table rand state))
                  )
               ;;(we proved and merged, or failed or timed-out and didn't merge)
               ;;I'd like to simplify the dag here, but I think it would be too slow (would change the numbering and we'd have to redo the test cases, etc.)
               (if (or (eq :proved result)
                       (eq :timed-out result)
                       (eq :failed result))
                   ;;                                     (and (not new-runes)
                   ;;                                      (not new-fn-names))
                   ;; no rules or fns were generated, so continue the sweep:
                   (let* ((provedp (eq :proved result)) ; :timed-out is treated the same as :failed
                          (sweep-array (if provedp
                                           (update-tags-for-proved-equal-node nodenum-to-replace sweep-array)
                                         (update-tags-for-failed-equal-node nodenum-to-replace other-val sweep-array))))
                     (perform-miter-sweep-aux (if provedp (+ 1 nodenum-to-replace) nodenum-to-replace) ; next nodenum to consider
                                              (or changep provedp)
                                              miter-array-name
                                              miter-array miter-len miter-depth ;depth-array
                                              sweep-array ;parent-array-name parent-array
                                              var-type-alist
                                              top-node print debug-nodes interpreted-function-alist rewriter-rule-alist prover-rule-alist extra-stuff monitored-symbols
                                              assumptions test-cases test-case-array-alist sweep-num (+ 1 step-num) total-steps
                                              analyzed-function-table unroll miter-is-purep nodes-to-not-use-prover-for
                                              (or some-goal-timed-outp
                                                  (eq :timed-out result))
                                              max-conflicts miter-name nodenums-not-to-unroll
                                              options
                                              rand state))
                 ;; Otherwise, we analyzed a loop fn (and returned some lemmas and/or fns)
                 ;; abort the sweep
                 ;; fixme - can we do better than starting all over here?
                 ;; e.g., reuse the probable-sets (after fixing them up?), etc.?
                 (mv (erp-nil) result miter-array analyzed-function-table rand state)))))))))

 ;;rename prove-or-simplify-miter?
 ;;ffixme think this through
 ;;returns (mv erp result miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state)
 ;;where if ERP is nil, then result is :proved-miter, :did-nothing (wasn't able to do any merging), or :did-something
 (defun perform-miter-sweep (miter-array-name miter-array miter-len miter-depth
                             var-type-alist ; can only contain axe-types, so may not give types to all vars
                             test-cases ;give values to the input vars (may be more here than we want to use)
                             interpreted-function-alist print
                             debug-nodes rewriter-rule-alist prover-rule-alist transformation-rules extra-stuff monitored-symbols assumptions use-context-when-miteringp
                             sweep-num analyzed-function-table unroll max-conflicts miter-name options rand state)
   (declare (xargs :guard (and ;;...
                               (var-type-alistp var-type-alist)
                               (or (null max-conflicts) (natp max-conflicts))
                               (symbolp miter-name)
                               (not (eq 'dag-array miter-array-name)))
                   :mode :program :stobjs (rand state)))
   ;;ffixme what if the miter is a constant?? maybe not possible..
   (b* ((- (cw "(Sweep ~x0 (depth ~x1, max-conflicts ~x2) for ~x3 (~x4 nodes).~%" sweep-num miter-depth max-conflicts miter-name miter-len))
        (- (cw "(Assumptions:~%~x0)~%" assumptions))
        ;;also, maybe pass around and print the refined assumptions??
        (state (if (print-level-at-least-tp print)
                   (progn$ (cw "(Writing DAG to file:~%")
                           (let ((state (print-dag-array-to-temp-file miter-array-name miter-array miter-len (concatenate 'string (symbol-name miter-name) "-DAG-BEFORE-SWEEP-" (nat-to-string sweep-num)) state)))
                             (prog2$ (cw ")~%")
                                     state)))
                 (prog2$ (cw "(DAG: :elided (~x0 nodes))~%" miter-len)
                         state)))
        ;; this also checks that every var has a good type for stp (todo: generalize pure proof machinery to infer types):
        (miter-is-purep (dag-array-is-purep miter-array-name miter-array miter-len var-type-alist)) ;optimization for the ciphers (it was slow to check whether each pair was pure
        ((mv shuffled-test-cases rand) ;fixme can we do this less often?  we want the test cases in their original order when analyzing traces of rec fns..
         (shuffle-list test-cases rand))
        ((mv all-passedp ; actually a hard error will already have been thrown
             probably-equal-node-sets ;includes probably-constant nodes
             & ; never-used-nodes ; todo: don't bother returning this?
             probably-constant-node-alist
             test-case-array-alist ;invalid (nil?) if we are not keeping test cases
             )
         ;;perhaps this should indicate whether any test case made the top node false, and we should handle that failure here (if we're not in the top level miter, throwing a hard error seems like a mistake ffixme).
         (find-probable-facts miter-array-name miter-array miter-len miter-depth
                              shuffled-test-cases
                              interpreted-function-alist print
                              (some-node-is-a-rec-fn-to-handlep (+ -1 miter-len) miter-array-name miter-array miter-len state) ; (not miter-is-purep) ; whether to keep test cases
                              debug-nodes
                              ;;(equal 0 miter-depth) ;abandon-testing-when-boringp (only do it on top-level miters since nested miters test are not in random order (may start with many tests from the same trace)
                              ))
        ((when (not all-passedp))
         (mv :false-test-case :dit-nothing miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
        (sweep-array-name 'sweep-array) ;ffixme use a different name, according to the miter depth?
        ;; Set up the tags that are used to choose which node or node pair to handle next:
        (sweep-array (new-array1 sweep-array-name miter-len))
        ;;mark all nodes that are probably constants:
        ;;the tags are the constant values themselves (quoted)
        (sweep-array (prog2$ (and print (eq :verbose print) (cw "Identifying and tagging probably-constant nodes...~%"))
                            (tag-probably-constant-nodes probably-constant-node-alist sweep-array)))
        ;; mark nodes that are probably equal to other nodes (including constants, in case we can't prove x=const and y=const but can prove x=y):
        (sweep-array (prog2$ (and print (eq :verbose print) (cw "Tagging probably-equal nodes for replacement...~%"))
                            (tag-probably-equal-node-sets probably-equal-node-sets sweep-array probably-constant-node-alist)))
        (num-probably-equal-node-sets (count-merges-in-probably-equal-node-sets probably-equal-node-sets 0)) ;; TODO: Can we really count this ahead of time?
        (num-probable-constants (len probably-constant-node-alist))
        (- (progn$ (cw "(~x0 total probably-equal-node-sets.~%" num-probably-equal-node-sets) ;fixme this total should exclude the probably constant nodes..
                   (and (print-level-at-least-tp print)
                        (progn$ (cw "Here they are, after excluding probably-constant nodes:~%") ;count the nodes involved (or track that number)
                                (print-non-constant-probably-equal-sets probably-equal-node-sets sweep-array) ;sort these?
                                ))
                   (cw ")~%")
                   (cw "~%(Probably-constant nodes (~x0 total)" num-probable-constants)
                   (and print (progn$ (cw ":~%")
                                      (print-list (merge-sort-car-<-2 probably-constant-node-alist))
                                      ))
                   (cw ")~%")))
;                    (parent-array-name (pack$ miter-array-name '-parent-array))
;                    (parent-array (prog2$ (and print (eq :verbose print) (cw "Making parent array...~%" nil)) (make-dag-parent-array-with-name (+ -1 miter-len) miter-array-name miter-array parent-array-name)))
        ((mv erp result miter-array analyzed-function-table rand state) ;i guess this doesn't change miter-len
         ;; Merge nodes until done or a theorem is generated:
         (perform-miter-sweep-aux 0
                                  nil ;initial changep
                                  miter-array-name
                                  miter-array miter-len miter-depth ;depth-array
                                  sweep-array
                                  ;;parent-array-name parent-array
                                  var-type-alist (+ -1 miter-len) ;nodenum of top node
                                  print debug-nodes interpreted-function-alist
                                  rewriter-rule-alist prover-rule-alist extra-stuff monitored-symbols assumptions
                                  (firstn 512 test-cases) ;fixme
                                  test-case-array-alist
                                  sweep-num
                                  1 ; step-num (todo: but depth and sweep numbers start at 0)
                                  (+ num-probably-equal-node-sets num-probable-constants)
                                  analyzed-function-table unroll
                                  miter-is-purep
                                  (nodes-to-not-use-prover-for (+ -1 miter-len) miter-array-name miter-array)
                                  nil ;some-goal-timed-outp ;no nodes have timed out yet
                                  max-conflicts miter-name
                                  nil ;initial nodenums-not-to-unroll
                                  options
                                  rand state))
        ((when erp)
         (mv erp nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state)))
     ;;sweep-array may encode information about failed merges.  We could return it and fix it up after simplifying the dag instead of recalculating it.  A better plan might be to return test cases when possible that disambiguate nodes that failed to merge (not always possible if some nodes were cut out).
     (if (eq :proved-miter result)
         (prog2$ (cw "Sweep ~x0 proved the miter (~x1)!)~%" sweep-num miter-name)
                 (mv (erp-nil) :proved-miter miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
       (if (eq :did-nothing result)
           (prog2$ (cw "Sweep ~x0 did nothing!)~%" sweep-num)
                   (mv (erp-nil) :did-nothing miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
         (if (eq :did-something result)
             ;;fffixme There can be a loop between mitering and simplifying.  consider: node x is replaced by y during mitering, but some (not all) instances of y simplify back to x during rewriting.
             ;;fffixme think more about this.  maybe if we merged any node with a constant that should count as doing something (could that happen as part of a loop?)
             ;;fffixme what should happen here? lightweight simplification and concretization, then keep sweeping?
             (prog2$ (cw "Sweep ~x0 did something but we are treating it as nothing to avoid loops!!)~%" sweep-num)
                     (mv (erp-nil) :did-nothing miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
           ;; the sweep did some merging and/or generated some rules (and maybe some functions).
             ;; use the rules (if any) to simplify the dag and keep sweeping:
             (if (not (or (eq (car result) :new-rules)
                          (eq (car result) :apply-rule)))
                 (prog2$ (hard-error 'perform-miter-sweep "don't yet support this result: ~x0" (acons #\0 result nil))
                         (mv (erp-t) nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
               ;; Result is (list :apply-rule rule-symbol nodenum alist other-runes other-fns) or (list :new-rules new-runes new-fns):
               ;; We'll apply the rule first (but only in the :apply-rule case), then simplify
               (b* ((apply-rulep (eq :apply-rule (car result)))
                    (new-runes (if apply-rulep (fifth result) (second result)))
                    (new-fns (if apply-rulep (sixth result) (third result)))
                    ((mv erp miter-array miter-len)
                     (if apply-rulep
                         (let ((rule-symbol (second result))
                               (nodenum (third result))
                               (alist (fourth result)))
                           (prog2$ (cw "Applying rule ~x0 to node ~x1 using alist ~x2.~%" rule-symbol nodenum alist)
                                   (apply-rule-at-nodenum rule-symbol nodenum alist miter-array-name miter-array miter-len state)))
                       (mv (erp-nil) miter-array miter-len)))
                    ((when erp) (mv erp nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
                    (- (cw "((Sweep ~x0 did some merging and/or generated rules (and maybe functions).  We'll simplify the dag using the rules (if any).)~%" sweep-num))
                    (- (and new-fns (cw "(Adding interpreted functions:~x0.)~%" new-fns)) ;make sure they are actually new?
                       )
                    (interpreted-function-alist (add-fns-to-interpreted-function-alist new-fns ;fffixme make sure the entires are consistent?
                                                                                       interpreted-function-alist (w state)))
                    ((mv erp new-rules) (make-axe-rules new-runes (w state)))
                    ((when erp) (mv erp nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state))
                    ;;each rune may result in several rewriter-rules (one for each conjunct):
                    (- (cw "(new runes: ~x0.)~%" (map-rule-symbol new-rules))) ;just prints the new ones - error if none are new?
                    ;;                                    (rewriter-rules (union-equal new-rules rewriter-rules)) ;slow?
;slow?
                    ;; Rules that transform (dropping, peeling, splitting, unrolling, etc.) should only be used in the rewriter (not the prover, since they might be expensive).
                    ;; Other rules (the lemmas about recursive functions' return values and equivalences between two functions should be used in both.

                    ;;previously we added all of new-rules ;;we need the type info, so doing this was a mistake: (filter-rules-to-use-in-prover new-rules) the rationale was that the theorem about a function should fire in rewriting
                    (non-transformation-rules-to-add (filter-rules-to-use-in-prover new-rules state))
                    (new-transformation-rules (set-difference-equal new-rules non-transformation-rules-to-add))
                    (transformation-rules (append new-transformation-rules transformation-rules))
                    (- (cw "(Adding non-transformation rules: ~x0.)~%" (map-rule-symbol non-transformation-rules-to-add)))
                    ;;                                     (prover-rules (union-equal rules-to-add-to-prover
                    ;;                                                                prover-rules)) ;slow?
                    (priorities (table-alist 'axe-rule-priorities-table (w state))) ;could pass this around
                    (rewriter-rule-alist (extend-rule-alist non-transformation-rules-to-add t priorities rewriter-rule-alist))
                    (prover-rule-alist (extend-rule-alist non-transformation-rules-to-add t priorities prover-rule-alist))

                    (monitored-symbols (union-eq nil ;;Sun Mar 14 01:05:07 2010
                                                 ;;(keep-rewrite-rule-names new-rule-names)
                                                 monitored-symbols))
                    ;;if this doesn't change anything, can reuse test cases from last time? (not if we applied a rule above?!)
                    ;;or should we just fail?
                    ;;bozo drop this conversion by passing the rewriter an array directly?
;fixme drop-non-supporters?
                    (dag-lst (dag-array-to-dag-lst2 miter-array-name miter-array (+ -1 miter-len))) ;rename dag-array-to-dag-lst2 if the last param is a nodenum, not a len
                    (- (and print (prog2$ (cw "(Miter DAG to simplify after sweep ~x0 (depth ~x1):~%" sweep-num miter-depth)
                                          nil ;(print-list dag-lst)
                                          )))
                    (state (if (print-level-at-least-tp print)
                               (print-dag-array-to-temp-file miter-array-name miter-array miter-len
                                                             (concatenate 'string (symbol-name miter-name) "-DAG-TO-SIMP-AT-END-OF-SWEEP-" (nat-to-string sweep-num)) state)
;fixme at least print the number of nodes
                             state))
                    (- (and print (cw ")")))
                    (print-for-rewriting t) ;fixme use the passed in print?
                    ;;first do a quick simplification pass to make use of any merging that was done on the sweep (e.g., if-tests that were turned into constants)
                    ((mv erp dag-lst state)
                     (simp-dag dag-lst
                               :rules (append (boolean-rules) (booleanp-rules) (base-rules)) ;ffffixme what else?  equal of self, etc? nth of cons?
                               :interpreted-function-alist interpreted-function-alist
                               :assumptions assumptions
                               :print print-for-rewriting
                               :normalize-xors nil
                               :memoizep nil ;does this make it faster?
                               :use-internal-contextsp use-context-when-miteringp
                               :check-inputs nil))
                    ((when erp) (mv erp nil
                                    miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                    analyzed-function-table monitored-symbols rand state))
                    (dag-lst (concretize-using-contexts dag-lst)) ;; eventually build this into the rewriter?? ;new - return and check changep?
                    ;;fixme should we not work-hard on some of these simplifications?
                    ;;another quick pass to use the concretization (could the result have more concretization to do?):
                    ((mv erp dag-lst state)
                     (simp-dag dag-lst
                               :rules (append (boolean-rules) (booleanp-rules) (base-rules)) ;ffffixme what else?  equal of self, etc? nth of cons?
                               :interpreted-function-alist interpreted-function-alist
                               :assumptions assumptions
                               :print print-for-rewriting
                               :normalize-xors nil
                               :memoizep nil ;does this make it faster?
                               :use-internal-contextsp use-context-when-miteringp
                               :check-inputs nil))
                    ((when erp) (mv erp nil
                                    miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                    analyzed-function-table monitored-symbols rand state))
                    ;;fffffixme simplifying :unused nodes can lead to loops (consider a function that doesn't terminate in this case but is guarded above by ifs that we can't yet resolve):  call a deeper rewriter function here? - could also make use of the renaming alist returned by such a function..
;ffixme could leave alone the nodes below the current point (but what if a generated theorem leads to a better context for one of them?)
;;;ffixme come to think of it, if we're not simplifying after each merge, the contexts may not be as good as they can be.. (are we even using contexts now?)
                    ((mv erp dag-lst state)
                     (simp-dag dag-lst
                               :rule-alist (extend-rule-alist transformation-rules t priorities rewriter-rule-alist)
                               :interpreted-function-alist interpreted-function-alist
                               :assumptions assumptions
                               :print print-for-rewriting
                               ;;ffixme the new runes might not fire here (since they may rewrite equalities)
                               ;;may have to wait until we actually make the miter equalities... for that kind of generated rule, just use it in place?
                               :monitor monitored-symbols
                               :normalize-xors nil
                               :memoizep t ;(not use-context-when-miteringp) ;nil ;Fri May 14 10:08:50 2010
                               :use-internal-contextsp use-context-when-miteringp
                               :check-inputs nil))
                    ((when erp) (mv erp nil
                                    miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                    analyzed-function-table monitored-symbols rand state))
                    (dag-lst (concretize-using-contexts dag-lst)) ;new, check for quotep here?
                    ;;another quick pass to use the concretization (could the result have more concretization to do?):
                    ((mv erp dag-lst state)
                     (simp-dag dag-lst
                               :rules (append (boolean-rules) (booleanp-rules) (base-rules)) ;ffffixme what else?  equal of self, etc? nth of cons?
                               :interpreted-function-alist interpreted-function-alist
                               :assumptions assumptions
                               :print print-for-rewriting
                               :normalize-xors nil
                               :memoizep nil ;for speed?
                               :use-internal-contextsp use-context-when-miteringp
                               :check-inputs nil))
                    ((when erp) (mv erp nil
                                    miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                    analyzed-function-table monitored-symbols rand state)))
                 (if (quotep dag-lst)
                     (if (equal *t* dag-lst)
                         (prog2$ (cw "Simplified to true! end simp) end sweep ~x0)~%" sweep-num) ;parens may be wrong (or maybe not!)
                                 (mv (erp-nil) :proved-miter miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                     analyzed-function-table monitored-symbols rand state))
                       (prog2$ (cw "!! ERROR DAG simplified to the non-t constant ~x0 !!)" dag-lst)
                               (prog2$ (hard-error 'perform-miter-sweep "Dag should not simplify to a non-nil-constant (maybe the assumptions contradict))" nil)
                                       (mv (erp-t) nil
                                           miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                           analyzed-function-table monitored-symbols rand state))))
                   ;;here we analyze dag-lst for tuples whose individual components are not exposed to mitering
                   ;;to do so, we examine the inputs to rec fns
                   (mv-let
                     (erp dag-lst-or-quotep state)
                     (rewrite-to-expose-tuple-elements dag-lst assumptions rewriter-rule-alist analyzed-function-table state)
                     (if erp
                         (mv erp nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                             analyzed-function-table monitored-symbols rand state)
                       (if (quotep dag-lst-or-quotep)
                           (if (equal *t* dag-lst-or-quotep)
                               (prog2$ (cw "Simplified to true! end sweep ~x0)~%" sweep-num) ;parens may be wrong?? or maybe okay
                                       (mv (erp-nil) :proved-miter miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                           analyzed-function-table monitored-symbols rand state))
                             (prog2$ (cw "!! ERROR DAG simplified to the non-t constant ~x0 !!)" dag-lst)
                                     (prog2$ (hard-error 'perform-miter-sweep "Dag should not simplify to a non-nil-constant (maybe the assumptions contradict))" nil)
                                             (mv (erp-t) nil
                                                 miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules
                                                 analyzed-function-table monitored-symbols rand state))))
                         (b* ( ;;fixme - make sure something changed, or this can loop! huh?
                              (miter-len (len dag-lst-or-quotep))
                              (miter-array (alist-to-array1 miter-array-name dag-lst-or-quotep))
                              (- (and print (cw "Miter DAG after sweep ~x0 (depth ~x1):~%" sweep-num miter-depth)))
                              ;;fixme do we now print the dag before and after each sweep?  is that a waste?
                              (state (if (print-level-at-least-tp print)
                                         (print-dag-array-to-temp-file miter-array-name miter-array miter-len
                                                                       (concatenate 'string (symbol-name miter-name) "-DAG-AFTER-SWEEP-"
                                                                                    (nat-to-string sweep-num)) state)
                                       ;;fixme at least print the number of nodes
                                       state))
                              (- (progn$ (cw "Done simplifying the miter.)~%")
                                         (cw "(Functions created on sweep ~x0: ~x1)~%" sweep-num new-fns)
                                         (cw "(Rules created on sweep ~x0: ~x1)~%" sweep-num new-runes)
                                         (cw "End Sweep ~x0.)~%" sweep-num))))
                           (mv (erp-nil) :did-something miter-array miter-len interpreted-function-alist rewriter-rule-alist
                               prover-rule-alist transformation-rules
                               analyzed-function-table monitored-symbols rand state)))))))))))))

 ;;repeatedly sweep up the miter
 ;;each sweep either reduces the miter to true or possibly does some merging and then generates some lemmas (and fns), which are used to simplify the dag before the next sweep
 ;;Returns (mv erp result miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist analyzed-function-table monitored-symbols rand state),
 ;;where if ERP is NIL, then result is :proved-miter, or :done (did all the merging we could [except for max-conflicts etc] and didn't prove the miter)
 ;;fixme - check that, if we generated some lemmas, at least one of them fires - is it possible that all we need is to simplify with other lemmas to make progress?
 ;;FIXME - moved the use of the generated lemmas down?
 ;;The reason we may need more than one sweep is that synchronizing transformations may occur.
 ;;what if test-cases is nil?
 ;;fffixme should this take the miter as a dag-lst? maybe not
;fffixme should this return transformation-rules?
 (defun perform-miter-sweeps (miter-array-name miter-array miter-len
                              miter-depth
                              var-type-alist ; can only contain axe-types, so may not give types to all vars
                              test-cases
                              interpreted-function-alist print debug-nodes
                              rewriter-rule-alist prover-rule-alist transformation-rules
                              assumptions extra-stuff monitored-symbols
                              use-context-when-miteringp sweep-num analyzed-function-table unroll
                              max-conflicts miter-name options rand state)
   (declare (xargs :guard (and
                               ;;...
                               (var-type-alistp var-type-alist)
                               (or (null max-conflicts) (natp max-conflicts))
                               (symbolp miter-name))
                   :mode :program :stobjs (rand state)))
   (mv-let (erp result miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist transformation-rules analyzed-function-table monitored-symbols rand state)
     (perform-miter-sweep miter-array-name miter-array miter-len miter-depth var-type-alist test-cases interpreted-function-alist
                          print debug-nodes rewriter-rule-alist prover-rule-alist transformation-rules extra-stuff
                          monitored-symbols assumptions use-context-when-miteringp sweep-num analyzed-function-table unroll
                          max-conflicts miter-name options rand state)
     (if erp
         (mv erp nil  miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist analyzed-function-table monitored-symbols rand state)
       (if (eq :proved-miter result)
           (mv (erp-nil) :proved-miter miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist analyzed-function-table monitored-symbols rand state)
         (if (eq :did-nothing result)
             (mv (erp-nil) :done miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist analyzed-function-table monitored-symbols rand state)
           (if (eq :did-something result)
               (perform-miter-sweeps miter-array-name miter-array miter-len miter-depth var-type-alist test-cases interpreted-function-alist
                                     print
                                     nil ; debug-nodes (can't pass these on because they are likely meaningless after the first sweep)
                                     rewriter-rule-alist prover-rule-alist transformation-rules
                                     assumptions
                                     extra-stuff
                                     monitored-symbols
                                     use-context-when-miteringp
                                     (+ 1 sweep-num)
                                     analyzed-function-table
                                     unroll max-conflicts miter-name options
                                     rand state)
             (prog2$ (er hard 'perform-miter-sweeps "ERROR: This should not happen.")
                     (mv (erp-t) nil miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist analyzed-function-table monitored-symbols rand state))))))))

 ;;this could be made more efficient if we reused the test cases (but will have to keep track of what happens to the nodes during simplification..)
 ;;this requires that each function appear only once -- we keep track of already-handled functions by their names (now only on the global level, not within this function?)
 ;; Returns (mv erp changep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
 ;; may need previous lemmas (or types) to generate the right type hyps for later lemmas?
 ;; this does one sweep
 (defun sweep-for-pre-simplify-recursive-functions (rec-fn-nodenums
                                                    dag-array-name dag-array interpreted-function-alist
                                                    rewriter-rule-alist ;gets extended
                                                    prover-rule-alist ;gets extended
                                                    ;;assumptions ; ttodo
                                                    extra-stuff test-cases
                                                    test-case-array-alist
                                                    analyzed-function-table
                                                    unroll
                                                    monitored-symbols max-conflicts
                                                    changep print miter-depth options
                                                    rand state)
   (declare (xargs :stobjs (rand state) :mode :program))
   ;;fixme can we just call analyze-rec-fns?
   (if (endp rec-fn-nodenums)
       (mv nil changep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
     (let ((nodenum (first rec-fn-nodenums))) ;(find-unhandled-rec-fn 0 dag-len dag-array-name dag-array done-fns state)
       (prog2$
        (cw "(Pre-Simplifying at node ~x0 (depth ~x1).~%" nodenum miter-depth)
        (mv-let (erp result analyzed-function-table rand state)
          (analyze-rec-fn nodenum dag-array-name dag-array interpreted-function-alist extra-stuff
                          rewriter-rule-alist prover-rule-alist test-cases test-case-array-alist analyzed-function-table
                          unroll (+ 1 miter-depth) monitored-symbols max-conflicts print options rand state)
          (if erp
              (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
            ;;catch errors?
            (if (or (eq result :failed)
                    (eq result :error))
                (progn$ (cw "!! Did not presimplify node ~x0.)~%" nodenum)
;(hard-error 'sweep-for-pre-simplify-recursive-functions "" nil) ;this fired when there were no test cases for a rec fn..
                        ;;something went wrong, so keep looking for the next rec. fn.
                        (sweep-for-pre-simplify-recursive-functions (rest rec-fn-nodenums)
                                                                    dag-array-name dag-array interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                                                    ;;assumptions
                                                                    extra-stuff
                                                                    test-cases test-case-array-alist analyzed-function-table unroll monitored-symbols
                                                                    max-conflicts changep print miter-depth options rand state))
              ;;otherwise, we returned (list new-runes new-fn-names)
              ;; trying without simplifying here...  if we do simplify, we need to update test-case-array-alist
              (b* ( ;(fn (ffn-symb (aref1 dag-array-name dag-array nodenum)))
                     (new-runes (first result))
                     (new-fn-names (second result))
                     (- (and new-fn-names (cw "(Adding ifns: ~x0.)~%" new-fn-names)))
                     (interpreted-function-alist (add-fns-to-interpreted-function-alist new-fn-names interpreted-function-alist (w state)))
                     ((mv erp new-rules) (make-axe-rules-aux new-runes (known-booleans (w state)) t nil (w state)))
                     ((when erp) (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))
;(dummy2 (cw "New rules: ~x0~%.  We'll try to use them to simplify the dag:~%" new-rules))
                     (rewriter-rule-alist (extend-rule-alist new-rules t (table-alist 'axe-rule-priorities-table (w state)) rewriter-rule-alist))
                     (prover-rule-alist (extend-rule-alist (filter-rules-to-use-in-prover new-rules state) t (table-alist 'axe-rule-priorities-table (w state)) prover-rule-alist))
                     (monitored-symbols (union-eq nil ;(keep-rewrite-rule-names new-runes) ;Wed Mar 16 23:40:55 2011 fixme at least don't monitor rules with no hyps or other dumb stuff.
                                                  monitored-symbols))
                     ;;make sure one (all?) of the new dag-runes fire when we (eventually) simplify?
                     (- (cw "Done pre-simplifying at node ~x0)~%" nodenum)))
                (sweep-for-pre-simplify-recursive-functions (rest rec-fn-nodenums)
                                                            dag-array-name dag-array interpreted-function-alist rewriter-rule-alist prover-rule-alist ;assumptions
                                                            extra-stuff test-cases test-case-array-alist analyzed-function-table unroll monitored-symbols max-conflicts
                                                            (or changep new-runes) print miter-depth
                                                            options
                                                            rand state)))))))))

 ;; Returns (mv erp dag-lst-or-quotep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
 ;;keeps sweeping and simplifying (without doing the work-hard hyps in the simplify) until no more lemmas are generated
 (defun sweeps-for-pre-simplify-recursive-functions (dag-lst
                                                     dag-array-name ;dag-array dag-len
                                                     interpreted-function-alist
                                                     rewriter-rule-alist ;gets extended
                                                     prover-rule-alist ;gets extended
                                                     assumptions
                                                     extra-stuff
                                                     test-cases ;each assigns values to the inputs
                                                     analyzed-function-table
                                                     unroll
                                                     monitored-symbols max-conflicts
                                                     sweep-count print
                                                     debug-nodes
                                                     normalize-xors
                                                     proof-name miter-depth options
                                                     rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :stobjs (rand state) :mode :program))
   (progn$
    (cw "(Doing pre-simplification sweep ~x0:~%" sweep-count)
    (let ((rec-fn-nodenums (find-unhandled-rec-fn-nodes-simple dag-lst nil state))
;(rec-fn-nodenums (find-unhandled-rec-fn-nodes 0 dag-len dag-array-name dag-array nil state))
          )
      (if (not rec-fn-nodenums)
          (prog2$ (cw "No more loop fns to handle.)~%")
                  (mv nil dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))
        (let* ((dag-array (alist-to-array1 dag-array-name dag-lst)) ;call a -with-len version?
               (dag-len (len dag-lst)) ;rename miter-len
               ;;fixme just print the dag-lst? or have miter and merge print before presimp and then print after each presimp sweep that changes something?
               (state (if (print-level-at-least-tp print)
                          (print-dag-array-to-temp-file dag-array-name dag-array dag-len (concatenate 'string (symbol-name proof-name) "-BEFORE-PRE-SIMP-" (nat-to-string sweep-count)) state)
                        state)))
          (mv-let
            (erp changep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
            (progn$
             (cw "(Evaluating test cases:")
             ;;fixme if the only purpose of the test cases is to provide inputs for rec fns then we can omit any nodes above the topmost unanalyzed rec fn (or above the one we will attack on this sweep, if we change things to do one per sweep)
             (let ((test-case-array-alist
                    (make-test-case-alist test-cases
                                          dag-array-name dag-array dag-len interpreted-function-alist print
                                          (pack$ 'test-case-array "-" (nat-to-string miter-depth)) ;depth is new Wed Sep  8 09:36:05 2010
                                          0 ;;initial test-case-count
                                          nil
                                          debug-nodes)))
               (prog2$ (cw "Evaluated ~x0 test cases.)~%(Will now analyze recursive functions for sweep ~x1.)~%"
                           (len test-case-array-alist) sweep-count)
                       (mv-let (erp changep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
                         (sweep-for-pre-simplify-recursive-functions rec-fn-nodenums
                                                                     dag-array-name dag-array interpreted-function-alist rewriter-rule-alist
                                                                     prover-rule-alist ; assumptions
                                                                     ;;done-fns
                                                                     extra-stuff test-cases
                                                                     test-case-array-alist analyzed-function-table unroll monitored-symbols max-conflicts
                                                                     nil ;changep=nil
                                                                     print miter-depth options rand state)
                         (if erp
                             (mv erp nil  interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
                           (prog2$ (cw "(Done analyzing recursive functions for sweep ~x0.)~%" sweep-count)
                                   (mv nil changep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)))))))
            (if erp
                (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
              (prog2$ (cw "(Simplifying dag:") ; fffixme don't simplify if no change?
                      (let ((dag-lst (dag-array-to-dag-lst2 dag-array-name dag-array (+ -1 dag-len)))) ;fixme drop this conversion by passing the rewriter an array directly?
                        ;;fixme which rules are the new ones?  :monitor them here? they may very well not fire because mitering hasn't simplified their supporters..
                        ;;ffixme that can lead to lots of printing on behalf of work-hard functions - disable printing on behalf of them in this?:
;or if foo supports bar and this sweep transforms foo to foo-new, then bar's rule may not fire (since we lack a lemma about foo-new), so much printing may be done about bar's lemma
;if pre-simp does multiple sweeps, we only want to work-hard after the last one?
                        ;;fffffixme what if any of these steps simplifes the dag to a quotep?!
                        (mv-let (erp dag-lst state)
                          (simp-dag dag-lst
                                    :rule-alist rewriter-rule-alist
                                    :print print
                                    :interpreted-function-alist interpreted-function-alist
                                    :assumptions assumptions
                                    :normalize-xors normalize-xors
;:monitor monitored-symbols
                                    :work-hard-when-instructedp nil
                                    :tag proof-name ;fixme add to this?
                                    :check-inputs nil)
                          (if erp
                              (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
                            (let* ((dag-lst (concretize-using-contexts dag-lst))) ;new - return and check changep? fixme simplify and concretize until stable?
                              (mv-let ;;new (use a more restricted rule set first?):
                                (erp dag-lst state) ;rename dag-lst-or-quotep (here and elsewhere)
                                (simp-dag dag-lst
                                          :rule-alist rewriter-rule-alist
                                          :print print
                                          :use-internal-contextsp t ;new
                                          :memoizep nil
                                          :normalize-xors normalize-xors
                                          :interpreted-function-alist interpreted-function-alist
                                          :assumptions assumptions
                                          :monitor nil ;;monitored-symbols ;this can print a lot if things fail (since we are not working hard)
                                          :work-hard-when-instructedp nil
                                          :tag proof-name
                                          :check-inputs nil)
                                (if erp
                                    (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
                                  (progn$ (cw "Done simplifying dag.)~%")
                                          (if (quotep dag-lst)
                                              (prog2$ (cw "~%Done with pre-simplification sweep (dag became a constant!) ~x0.)~%" sweep-count)
                                                      (mv nil dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))
                                            (progn$
;fixme separate out the loop functions here:
                                             (cw "(Fns after pre-simplification sweep ~x0: ~x1)~%" sweep-count (dag-fns dag-lst)) ;fixme do better in the not printing case?
                                             (let* ( ;;(dag-array (alist-to-array1 dag-array-name dag-lst))
                                                    ;;(dag-len (len dag-lst))
;(state (if print (print-dag-array-to-temp-file dag-array-name dag-array dag-len
;                                          (concatenate 'string (symbol-name proof-name) "-DAG-AFTER-PS-SWEEP-" (nat-to-string sweep-count)) state)
;         state))
                                                    )
                                               (progn$
                                                (cw "~%Done with pre-simplification sweep ~x0.)~%" sweep-count)
                                                (if changep ;fffixme instead of this, use analyzed-function-table somehow?
                                                    ;;keep going:
                                                    (sweeps-for-pre-simplify-recursive-functions dag-lst ;dag-array dag-len
                                                                                                 dag-array-name
                                                                                                 interpreted-function-alist
                                                                                                 rewriter-rule-alist
                                                                                                 prover-rule-alist
                                                                                                 assumptions
                                                                                                 extra-stuff test-cases
                                                                                                 analyzed-function-table
                                                                                                 unroll
                                                                                                 monitored-symbols max-conflicts
                                                                                                 (+ 1 sweep-count)
                                                                                                 print debug-nodes
                                                                                                 normalize-xors
                                                                                                 proof-name miter-depth options
                                                                                                 rand state)
                                                  (mv nil dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)))))))))))))))))))))

 ;;handles all rec fns individually (if transformations introduce new functions, those are handled in turn).  fixme now that we always do this before a miter sweep, we don't need to check during the sweep whether all fns are handled individually?
;this may do more than one sweep - consider when sweep 1 drops and peels off from a function; then sweep 2 would prove the lemma about the new function
 ;;fixme move this into the mututal recursion and do it even for nested miters!
 ;; Returns (mv erp dag-lst-or-quotep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
 ;;ffixme this could return the evaluated test-cases?
 ;;bad name, since it's not justs implifying but also proving lemmas about the functions?
 ;;this is now much faster if there are no rec fns (and on the last step after all rec fns have been handled?)
 (defun pre-simplify-recursive-functions (dag-lst
                                          interpreted-function-alist
                                          rewriter-rule-alist ;gets extended
                                          prover-rule-alist   ;gets extended
                                          assumptions
                                          extra-stuff
                                          test-inputs ;each is an alist from input vars to values
                                          analyzed-function-table
                                          unroll
                                          monitored-symbols max-conflicts print
                                          normalize-xors
                                          proof-name ;fixme pass around as a string?
                                          miter-depth options
                                          rand state)
   (declare (xargs :guard (or (null max-conflicts) (natp max-conflicts))
                   :stobjs (rand state) :mode :program))
   (prog2$
    (cw "(Pre-Simplifying DAG:~%")
    (if (quotep dag-lst)
        ;;The dag is already a quotep:
        (prog2$ (cw "dag is a constant.)")
                (mv nil dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))
      (let* ((miter-array-name (pack$ 'pre-simp-miter-array-depth- (nat-to-string miter-depth))))
        (progn$
         (cw "(Assumptions:~%") ;could abstract this pattern into a function (print-list-wrapped tag item)
         (print-list assumptions)
         (cw ")~%")
         (cw "(Doing pre-simp sweeps:~%")
         (mv-let
           (erp dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols
                rand state)
           (sweeps-for-pre-simplify-recursive-functions dag-lst
                                                        miter-array-name ;miter-array dag-len
                                                        interpreted-function-alist rewriter-rule-alist prover-rule-alist
                                                        assumptions extra-stuff test-inputs
                                                        analyzed-function-table unroll monitored-symbols max-conflicts
                                                        0 ;sweep count
                                                        print
                                                        nil ;fffixme debug-nodes
                                                        normalize-xors ;drop?
                                                        proof-name miter-depth options rand state)
           (if erp
               (mv erp nil interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
             (prog2$
              (cw "done with pre-simp sweeps.)~%")
              (if (quotep dag-lst)
                  (progn$ (cw "Done pre-simplifying (result is a constant).)~%")
                          (mv nil dag-lst interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))
                (let* ((tag (pack$ (symbol-name proof-name) '-DAG-AFTER-PS)) ;fixme bad name, since we simplify below!
                       (state (if (print-level-at-least-tp print)
                                  (print-dag-to-temp-file dag-lst (symbol-name tag) state)
                                state)))
                  ;;ffixme concretize and rewrite until stable
                  (mv-let (erp dag-lst-or-quotep state) ;fffixme don't do this if the sweeps didn't do anything
                    ;;for this one we do do the work-hard (the default): (may need to do it after each sweep if the values flowing in to the rec fns need to be as nice as possible?)
                    (simp-dag dag-lst
                              :rule-alist rewriter-rule-alist
                              :print print
                              :use-internal-contextsp t
                              :memoizep nil
                              :monitor monitored-symbols ;new - fixme what other options?
                              :normalize-xors normalize-xors
                              :interpreted-function-alist interpreted-function-alist
                              :assumptions assumptions
                              :tag tag
                              :check-inputs nil)
                    (if erp
                        (mv erp nil  interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
                      (progn$ (cw "Done pre-simplifying.)~%")
                              (mv nil dag-lst-or-quotep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state))))))))))))))

;fixme i guess it's a requirement now that each loop fn appear only once - check that?  how could we relax that?
 ;; tries to prove the miter by sweeping (with max conflicts), then splitting.
 ;; fixme try with increasing max-conflicts.  fixme consider two modes (must prove, and best effort)
 ;; Returns (mv erp provedp rand state)
 ;; For best results, the miter passed in should already be simplified. - or this function could do it?
;rename - this doesn't actually make the miter?
 ;;pass in a parent-array, if we already have one??
 ;;what should this do if there are no test cases?
 ;; should this actually make the theorem?
;fixme perhaps up the depth just before calling this, instead of in 3 places..
 (defun miter-and-merge (dag-or-quotep
                         miter-name ;a symbol
                         miter-depth ;we may be proving this miter on behalf of an overarching miter, and so on
                         var-type-alist ;used if we need to call STP (callers can compute from the assumptions using make-var-type-alist-from-hyps) ; can only contain axe-types, so may not give types to all vars
                         interpreted-function-alist
                         print
                         debug-nodes
                         rewriter-rule-alist
                         prover-rule-alist
                         assumptions ; terms to be assumed non-nil
                         extra-stuff
                         test-cases ;alists from input vars to values (do all of these satisfy the assumptions?)
                         monitored-symbols
                         use-context-when-miteringp ;do we use this?
                         analyzed-function-table
                         unroll
                         tests-per-case
                         max-conflicts
                         must-succeedp ;if non-nil, this means we'll increase max-conflicts forever (fixme only do it as long as something is timing out!)
                         pre-simplify-rec-fnsp
                         normalize-xors
                         options
                         rand state)
   (declare (xargs :guard (and (or (myquotep dag-or-quotep)
                                   (pseudo-dagp dag-or-quotep))
                               (symbolp miter-name)
                               ;;...
                               (var-type-alistp var-type-alist) ; todo: allows more than we can handle when calling stp
                               ;...
                               (or (null max-conflicts) (natp max-conflicts)))
                   :mode :program :stobjs (rand state)))
   (if (quotep dag-or-quotep) ;get rid of this and improve pre simp to take a constant?
       (let ((val (unquote dag-or-quotep)))
         (if (eq t val)
             (prog2$ (cw "(The miter is the constant t.)~%")
                     (mv (erp-nil) t rand state))
           (if (eq nil val)
               (prog2$ (cw "(The miter is the constant nil.)~%") ;should this be a hard error?
                       (mv (erp-nil) nil rand state))
             (prog2$ (er hard? 'miter-and-merge "expected t or nil but got the constant ~x0." val)
                     (mv (erp-t) nil rand state)))))
     ;;Pre-simplify:
     (b* ((dag dag-or-quotep)
          ((mv erp dag-or-quotep interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)
           (if pre-simplify-rec-fnsp
               (pre-simplify-recursive-functions dag
                                                 interpreted-function-alist
                                                 rewriter-rule-alist
                                                 prover-rule-alist
                                                 assumptions
                                                 extra-stuff
                                                 (firstn tests-per-case test-cases) ;fixme think about the firstn ;fixme chose the most interesting ones
                                                 analyzed-function-table unroll monitored-symbols max-conflicts print
                                                 normalize-xors
                                                 miter-name
                                                 miter-depth options
                                                 rand state)
             (mv nil dag interpreted-function-alist analyzed-function-table rewriter-rule-alist prover-rule-alist monitored-symbols rand state)))
          ((when erp) (mv erp nil rand state)))
       (if (quotep dag-or-quotep)
           (let ((val (unquote dag-or-quotep)))
             (if (eq t val)
                 (prog2$ (cw "(The miter is the constant t.)~%")
                         (mv (erp-nil) t rand state))
               (if (eq nil val)
                   (prog2$ (cw "(The miter is the constant nil.)~%") ;should this be a hard error? not unless this miter must succeed?
                           (mv (erp-nil) nil rand state))
                 (prog2$ (er hard? 'miter-and-merge "expected t or nil but got the constant ~x0." val)
                         (mv (erp-t) nil rand state)))))
         ;; Not a constant;
         (b* ((dag dag-or-quotep)
              (miter-array-name (pack$ 'miter-array- miter-depth))
              (miter-array (alist-to-array1 miter-array-name dag)) ;call a -with-len version?
              (miter-len (len dag))
              (- (progn$ (cw "(Proving goal ~x0 (depth ~x1, len ~x2):~%" miter-name miter-depth miter-len) ;name the miters according to their cases...
                         (cw "(Using ~x0 test cases)~%" (len test-cases))
                         (cw "(Number of rewriter-rules: ~x0.)~%" (sum-of-cdr-lens rewriter-rule-alist))))
              ((when (not test-cases)) ;where should this check be done?
               (cw "ERROR no test cases! - no point in sweeping!") ; fffixme, well we could rewrite, i guess... that should be done outside this function?
               (mv nil ;todo: use t?
                   (hard-error 'miter-and-merge "no test cases!" nil)
                   rand state))
              ((when (not (all-< debug-nodes miter-len)))
               (er hard? 'miter-and-merge "At least one of the :debug-nodes is too large.")
               (mv :debug-node-too-large nil rand state))
              ((mv erp result miter-array miter-len interpreted-function-alist rewriter-rule-alist prover-rule-alist
                   & ; new-analyzed-function-table
                   monitored-symbols rand state)
               (perform-miter-sweeps miter-array-name miter-array miter-len
                                     miter-depth
                                     var-type-alist
                                     test-cases
                                     interpreted-function-alist print
                                     debug-nodes
                                     rewriter-rule-alist
                                     prover-rule-alist
                                     nil
                                     assumptions
                                     extra-stuff
                                     monitored-symbols
                                     use-context-when-miteringp
                                     0
                                     analyzed-function-table
                                     unroll max-conflicts miter-name options
                                     rand state))
              ((when erp) (mv erp nil rand state)))
           (if (eq :proved-miter result)
               (prog2$ (cw "Proved the goal.)~%")
                       (mv (erp-nil) t rand state))
             (b* ((- (cw "(May need to split the goal dag (depth ~x0, ~x1, ~x2):~%" miter-depth miter-name miter-array-name))
                  (state (if (print-level-at-least-tp print)
                             (print-dag-array-to-temp-file miter-array-name miter-array miter-len
                                                           (concatenate 'string (symbol-name miter-name) "-PRE-SPLIT")
                                                           state)
                           state))
                  (- (cw ")~%(But we'll simplify first, using assumptions: ~x0~%" assumptions))
                  (miter-dag (array-to-alist miter-array-name miter-array miter-len))
                  ;;since we are sometimes saying we did nothing when that is a lie, simplifying here may help:
                  ((mv erp miter-dag-or-quote state)
                   (simp-dag miter-dag
                             :rule-alist rewriter-rule-alist
                             :print :brief
                             :assumptions assumptions
                             :check-inputs nil))
                  ((when erp) (mv erp nil rand state))
                  ((when (quotep miter-dag-or-quote)) ; unusual?
                   (let ((val (unquote miter-dag-or-quote)))
                     (if (eq t val)
                         (prog2$ (cw "The goal simplified to the constant t.))~%")
                                 (mv (erp-nil) t rand state))
                       (if (eq nil val)
                           (prog2$ (cw "The goal simplififed to the constant nil.))~%") ;should this be a hard error? not unless this miter must succeed?
                                   (mv (erp-nil) nil rand state))
                         (prog2$ (er hard? 'miter-and-merge "expected t or nil but got the constant ~x0." val)
                                 (mv (erp-t) nil rand state))))))
                  (miter-dag miter-dag-or-quote)
                  (- (and (or (eq :verbose print) (eq :verbose! print))
                          (progn$ (cw "(Simplified goal dag (~x0):" miter-name)
                                  (print-list miter-dag) ;fixme print this to a file?
                                  (cw ")~%"))))
                  ;;(- (cw "(Assumptions:~%~x0)~%" assumptions))
                  (- (cw ")~%"))
                  (miter-len (len miter-dag))
                  (miter-array (alist-to-array1 miter-array-name miter-dag)) ;gross to convert here?
                  (nodenum-to-split-on (find-a-node-to-split-miter-on
                                        miter-array-name miter-len miter-array
                                        test-cases interpreted-function-alist)) ; ffixme think about heuristics!
                  )
               (if (not nodenum-to-split-on)
                   (prog2$
                    (cw "(Couldn't find any node to split on.)~%")
                    ;; TODO: should we consider bit-blasting here?
                    (if (not must-succeedp)
                        (prog2$ (cw "(Failing because we don't have to succeed on this goal.))")
                                (mv nil nil rand state))
                      (if (not max-conflicts)
                          (prog2$ (cw "(Failing because we would normally increase the max-conflicts but timing out is turned off.))")
                                  (mv nil nil rand state))
                        (if (< 10000000000 max-conflicts) ;; not sure what the limit should be but 2^64 causes an STP error
                            (prog2$ (cw "(Failing because the max-conflicts is too high.))")
                                    (mv nil nil rand state))
                          (let ((max-conflicts (* 2 max-conflicts))) ;; TODO: Don't do this if no queries timed out
                            (prog2$ (cw "(Increasing the max-conflicts to ~x0 and trying again.)~%" max-conflicts)
                                    (mv-let (erp provedp rand state)
                                      (miter-and-merge miter-dag
                                                       miter-name ;fixme change this to indicate the increased max-conflicts?
                                                       miter-depth
                                                       var-type-alist
                                                       interpreted-function-alist
                                                       print
                                                       debug-nodes
                                                       rewriter-rule-alist
                                                       prover-rule-alist
                                                       assumptions
                                                       extra-stuff
                                                       test-cases
                                                       monitored-symbols
                                                       use-context-when-miteringp
                                                       analyzed-function-table
                                                       unroll
                                                       tests-per-case
                                                       max-conflicts must-succeedp
                                                       pre-simplify-rec-fnsp
                                                       normalize-xors
                                                       options
                                                       rand state)
                                      (prog2$ (cw "End of proof attempt for ~x0)~%"  miter-name)
                                              (mv erp provedp rand state)))))))))
                 (b* ((- (cw "(Splitting goal on node ~x0.)~%" nodenum-to-split-on))
                      (split-assumption (dag-to-term-aux-array miter-array-name miter-array nodenum-to-split-on)) ;fffixme this can blow up if there's nothing small to split on!
                      ;;(split-assumption (orient-equality2 split-assumption)) ;too aggressive? ;handle nots and known preds? ;Fri Feb 26 01:48:01 2010
                      ;;fixme what if the assumption contradicts the known assumptions
                      ;; (maybe it should have been merged with false, but what if it only arose during the simplification after the merge?)
                      (- (cw "(Split assumption:~%~x0)~%" split-assumption))
                      (assumptions-for-true-case (cons split-assumption assumptions))
                      (- (cw "(Simplifying other assumptions using the split assumption:~%"))
                      (strengthen-rules
                       ;;ffixme more rules? fixme pull out?
                       ;;did not want turn-equal-around..
                       ;; TODO: Use plain make-axe-rules here
                       (append (make-axe-rules! (exit-test-simplification-rules) (w state))
                               (make-axe-rules! (strengthening-rules) (w state))))
                      ((mv erp assumptions-for-true-case state)
                       (strengthen-facts assumptions-for-true-case print strengthen-rules state))
                      ((when erp) (mv erp nil rand state))
                      (- (cw "Done.)~%"))
                      ((mv erp miter-dag-for-true-case state)
                       ;;fixme why not apply rule here too?!
                       (simp-dag miter-dag
                                 :rules nil ;fffixme?
                                 :assumptions assumptions-for-true-case ;ffixme what about the equiv? call something like concretize?
                                 :check-inputs nil))
                      ((when erp) (mv erp nil rand state))
                      ;; ffixme what about the equiv? the new assumption may not fire? call something like concretize?
                      (- (cw "(Unsimplified goal dag for true case:~%"))
                      (- (if (or (eq :verbose print) (eq :verbose! print))
                             (print-list miter-dag-for-true-case)
                           (cw ":elided"))) ;fixme what is this?
                      (- (cw ")~%(Simplifying:"))
                      ((mv erp miter-dag-for-true-case state)
                       (simp-dag miter-dag-for-true-case
                                 :rule-alist rewriter-rule-alist ;pass other rules?
                                 :assumptions assumptions-for-true-case
                                 :print print
                                 :check-inputs nil))
                      ((when erp) (mv erp nil rand state))
                      (- (cw "done)~%") ;nil ;(cw "Simplified miter dag for true case:~%")
                         )
                      ;; (- (print-list miter-dag-for-true-case)) ;don't print, since it will be printed by miter-and-merge?
                      ;;compute contexts? concretize?
                      ;;ffixme have we already checked that the test cases satisfy the assumptions (if they were random)?  only makes sense for outmost miter?
                      ((mv test-cases-for-true-case test-cases-for-false-case)
                       (partition-test-cases test-cases split-assumption interpreted-function-alist nil nil))
                      ;; fffixme add more test cases if needed and if depth=0
                      (- (cw "(True case:~%"))
                      ((mv erp provedp rand state)
                       (miter-and-merge miter-dag-for-true-case
                                        (pack$ miter-name "1")
                                        miter-depth
                                        var-type-alist ;ffixme think about this?
                                        interpreted-function-alist ;make sure these alists are always consistent?
                                        print
                                        debug-nodes
                                        rewriter-rule-alist
                                        prover-rule-alist
                                        assumptions-for-true-case
                                        extra-stuff
                                        test-cases-for-true-case
                                        monitored-symbols ;clear these out? use only what was passed in?
                                        use-context-when-miteringp
                                        (empty-analyzed-function-table) ;analyzed-function-table Mon Jan 24 15:32:32 2011
                                        unroll tests-per-case max-conflicts must-succeedp
                                        pre-simplify-rec-fnsp
                                        normalize-xors
                                        options
                                        rand state))
                      ((when erp) (mv erp nil rand state))
                      (- (cw "end true case)~%")))
                   (if (not provedp)
                       (prog2$ (cw "failed to prove true case.)")
                               (mv nil nil rand state))
                     ;;now attempt the false case:
                     (b* ((negated-split-assumption `(equal ,split-assumption 'nil)) ;orient before negating? maybe it's already oriented.. ;fixme use not?
                          (assumptions-for-false-case (cons negated-split-assumption assumptions))
                          ((mv erp assumptions-for-false-case state)
                           (strengthen-facts assumptions-for-false-case print strengthen-rules state))
                          ((when erp) (mv erp nil rand state))
                          ((mv erp miter-dag-for-false-case state)
                           (simp-dag miter-dag
                                     :rule-alist rewriter-rule-alist
                                     ;;ffixme use contexts? pass in ifns? what else?
                                     :assumptions assumptions-for-false-case ;ffixme what about the equiv? call something like concretize?
                                     :check-inputs nil))
                          ((when erp) (mv erp nil rand state))
                          ;;compute contexts? concretize?
                          ;; fffixme add more test cases if needed and if depth=0
                          (- (cw "(False case:~%"))
                          ;; (let* ( ;(dummy1 (cw "Miter dag for false case:~%"))
                          ;;(dummy2 (print-list miter-dag-for-false-case))
                          ;; (dummy ))
                          ;; (declare (ignore dummy))
                          ((mv erp provedp rand state)
                           (miter-and-merge miter-dag-for-false-case
                                            (pack$ miter-name "2")
                                            miter-depth
                                            var-type-alist ;ffixme think about this?
                                            interpreted-function-alist
                                            print
                                            debug-nodes
                                            rewriter-rule-alist
                                            prover-rule-alist
                                            assumptions-for-false-case
                                            extra-stuff
                                            test-cases-for-false-case
                                            monitored-symbols ;clear these out? use only what was passed in?
                                            use-context-when-miteringp
                                            (empty-analyzed-function-table) ;analyzed-function-table Mon Jan 24 15:32:32 2011
                                            unroll tests-per-case max-conflicts must-succeedp
                                            pre-simplify-rec-fnsp normalize-xors options
                                            rand state))
                          ((when erp) (mv erp nil rand state))
                          (- (cw "End false case)~%")))
                       (if (not provedp)
                           (prog2$ (cw "failed to prove false case.)")
                                   (mv nil nil rand state))
                         (prog2$ (cw "proved both cases.)")
                                 (mv nil t rand state))))))))))))))
 ) ;end mutual-recursion


;; TODO: Consider supporting miters that are not boolean-valued; currently we must prove the miter is T (not merely non-nil).
; Returns (mv erp provedp all-assumptions state rand).
; todo: separate out the top-level-miter stuff from the rest of this? then call this instead of simplifying and then calling miter-and-merge?
(defun prove-with-axe-core (dag-or-quotep
                            assumptions ; (untranslated) terms we can assume are true (non-nil)
                            types ;compute this from the hyps?  well, it can contain :range guidance for test case generation...
                            user-interpreted-function-alist ;todo: just pass in the fn names and look them up in the state?
                            test-types
                            test-case-count
                            tactic ;the total number of tests to generate?  some may not be used
                            print
                            debug-nodes
                            ;; ttodo: allow the use of rule phases?!
                            runes          ;used for both the rewriter and prover
                            rules          ;used for both the rewriter and prover
                            rewriter-runes ;used for the rewriter only (not the prover)
                            prover-runes ;used for the prover only (not the rewriter) ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                            initial-rule-set
                            initial-rule-sets
                            pre-simplify-rec-fnsp ;todo: get rid of this (always use t) -- no, we sometimes want to suppress this (when irrelevant nodes have rec fns)
                            extra-stuff
                            specialize-fnsp
                            monitored-symbols ;check these and maybe flesh out symbols into runes? or just use a list of symbols?
                            use-context-when-miteringp
                            random-seed
                            unroll
                            tests-per-case
                            max-conflicts
                            normalize-xors ; todo: use this more, deeper in?
                            prove-constants
                            proof-name     ; should no longer be :auto
                            state)
  (declare (xargs :guard (and (or (quotep dag-or-quotep)
                                  (weak-dagp dag-or-quotep))
                              (true-listp assumptions) ; untranslated
                              (or (eq :bits types)
                                  (eq :bytes types)
                                  (and (var-type-alistp types)
                                       (no-duplicatesp (strip-cars types))
                                       (not (assoc-eq nil types)) ;consider relaxing this?
                                       (not (assoc-eq t types)) ;consider relaxing this?
                                       ))
                              (interpreted-function-alistp user-interpreted-function-alist)
                              (test-case-type-alistp test-types)
                              (or (eq tactic :rewrite)
                                  (eq tactic :rewrite-and-sweep))
                              (natp test-case-count)
                              (print-levelp print)
                              (nat-listp debug-nodes)
                              (symbol-listp runes)
                              (axe-rule-listp rules)
                              (symbol-listp rewriter-runes)
                              (symbol-listp prover-runes)
                              (axe-rule-listp initial-rule-set)
                              (all-axe-rule-listp initial-rule-sets)
                              (not (and initial-rule-set initial-rule-sets)) ;it would be ambiguous which one to use
                              (booleanp pre-simplify-rec-fnsp)
                              (extra-stuff-okayp extra-stuff)
                              (booleanp specialize-fnsp)
                              (symbol-listp monitored-symbols)
                              (booleanp use-context-when-miteringp)
                              (or (null random-seed) ; todo: rename to maybe-random-seed
                                  (natp random-seed))
                              (or (eq :all unroll)
                                  (symbol-listp unroll))
                              (natp tests-per-case)
                              (or (eq :auto max-conflicts)
                                  (null max-conflicts)
                                  (natp max-conflicts))
                              (booleanp normalize-xors) ; todo: support :compact
                              (booleanp prove-constants)
                              (symbolp proof-name))
                  :mode :program
                  :stobjs state))
  (b* ((- (cw "~%(Proving top-level goal ~x0:~%" proof-name))
       ;; Desugar the special values :bits and :bytes for the types:
       (dag-vars (if (quotep dag-or-quotep) nil (dag-vars dag-or-quotep))) ; todo: make a dag-or-quotep-vars
       (var-type-alist (if (eq :bits types) ;todo: optimize this stuff:
                           (progn$ (cw "  (NOTE: Assuming all ~x0 vars in the DAG are bits.)~%" (len dag-vars))
                                   (pairlis$ dag-vars (repeat (len dag-vars) (make-bv-type 1))))
                         (if (eq :bytes types)
                             (progn$ (cw "  (NOTE: Assuming all ~x0 vars in the DAG are bytes.)~%" (len dag-vars))
                                     (pairlis$ dag-vars (repeat (len dag-vars) (make-bv-type 8))))
                           types)))
       ;; we have to reverse the alist here, because types can refer to later types
       (test-case-type-alist (reverse-list (uniquify-alist-eq (append test-types var-type-alist)))) ; the test-types, if any, override the types
       ;; Compare the vars in the DAG to the vars given types:
       (vars-given-types (strip-cars var-type-alist))
       (vars-given-test-types (strip-cars test-case-type-alist))
       (sorted-vars-given-types (merge-sort-symbol< vars-given-types))
       (sorted-vars-given-test-types (merge-sort-symbol< vars-given-test-types))
       ;; todo: optimize the subset tests here and below, since the lists are sorted:
       (- (and (not (subsetp-eq dag-vars sorted-vars-given-types))
               ;; (hard-error 'prove-with-axe-core
               ;;               "The DAG variables, ~\x0, don't match the variables given types in the alist, ~x1.  Vars not given types: ~x2.~%"
               ;;               (acons #\0 dag-vars
               ;;                      (acons #\1 sorted-vars-given-types
               ;;                             (acons #\2 (set-difference-eq dag-vars sorted-vars-given-types)
               ;;                                    nil))))
               ;; todo: mention the tactics that won't work:
               (let ((vars-not-given-types (set-difference-eq dag-vars sorted-vars-given-types))) ; todo: optimize
                 (if (eq tactic :rewrite-and-sweep)
                     (cw "WARNING: The ~x0 DAG variables, ~x1, are not given types in the alist, ~x2.  This will prevent sweeping-and-merging from working if rewriting can't prove the goal.~%" (len vars-not-given-types) vars-not-given-types test-case-type-alist)
                   (cw "WARNING: The ~x0 DAG variables, ~x1, are not given types in the alist, ~x2.~%" (len vars-not-given-types) vars-not-given-types test-case-type-alist)
                   ))))
       ((when (not (subsetp-eq sorted-vars-given-types dag-vars)))
        (if (quotep dag-or-quotep)
            (er hard? 'prove-with-axe-core "The following variables are given types in the alist, but the input to prove is just a constant: ~X01.~%" (set-difference-eq sorted-vars-given-types dag-vars) nil)
          (er hard? 'prove-with-axe-core "The following variables are given types in the alist but do not appear in the input DAG: ~X01.~%" (set-difference-eq sorted-vars-given-types dag-vars) nil))
        (mv :input-error nil nil state))
       ((when (not (subsetp-eq sorted-vars-given-test-types dag-vars)))
        (if (quotep dag-or-quotep)
            (er hard? 'prove-with-axe-core "The following variables are given test-types in the alist, but the input to prove is just a constant: ~X01.~%" (set-difference-eq sorted-vars-given-test-types dag-vars) nil)
          (er hard? 'prove-with-axe-core "The following variables are given test-types in the alist but do not appear in the input DAG: ~X01.~%" (set-difference-eq sorted-vars-given-test-types dag-vars) nil))
        (mv :input-error nil nil state))
       ;; Handle the case when dag-or-quotep is already a constant: ; todo: move this up?
       ((when (quotep dag-or-quotep))
        (if (equal *t* dag-or-quotep)
            (prog2$ (cw "The DAG is already the constant t!)~%")
                    (mv (erp-nil) t
                        nil ; no assumptions or types were actually used
                        state)
                    )
          (prog2$ (er hard? 'prove-with-axe-core "Tried to prove the goal is t, but it's the non-t constant ~x0" dag-or-quotep)
                  (mv :non-t-constant nil nil state))))
       (dag dag-or-quotep)
       (untranslated-assumptions-from-types (assumptions-from-var-type-alist var-type-alist nil))  ; is it going to be slow to have all of these around?
       (all-untranslated-assumptions (append assumptions untranslated-assumptions-from-types))
       ;; Translate assumptions:
       (wrld (w state)) ; todo: use more below
       (assumptions (translate-terms all-untranslated-assumptions 'prove-with-axe-core wrld)) ;throws an error on bad input
       (interpreted-function-alist (make-interpreted-function-alist
                                     (get-non-built-in-supporting-fns-list (dag-fns dag) *axe-evaluator-functions* (w state)) (w state))) ;Sat Feb 19 14:20:09 2011
       ;;doesn't actually check that the user supplied alist is consistent with the state (fixme just pass in the names and look them up in the current state)?
       (interpreted-function-alist (if (not (consistent-alists interpreted-function-alist user-interpreted-function-alist))
                                       (prog2$ (hard-error 'prove-with-axe-core "inconsistent interpreted function alists." nil) ;print more?
                                               nil)
                                     (append interpreted-function-alist user-interpreted-function-alist)))
       ;; TODO: Use plain make-axe-rules here
       (rewriter-rule-alist (make-rule-alist-simple (append (make-axe-rules! (append rewriter-runes runes) (w state)) rules) t (table-alist 'axe-rule-priorities-table (w state))))
       (prover-rule-alist (make-rule-alist-simple (append (make-axe-rules! (append prover-runes runes) (w state)) rules) t (table-alist 'axe-rule-priorities-table (w state))))
       ;; todo: why not always simplify (maybe there won't be any rules, but the tactic is now either :rewrite or :rewrite-and-sweep)?
       (simplifyp (or rewriter-rule-alist
                      (eq :rewrite tactic)
                      initial-rule-set
                      initial-rule-sets))
       ;; Begin by simplifying the DAG using the supplied axe-rules (if any).  We also simplify if the test case count is 0, because then simplifying is the only thing we can do. ffixme even if there are no rules supplied, we might we want to simplify to evaluate constants, etc.??  but it could be slow to do so if the dag is already simplified with some rule set (will almost always be the case) -- todo: make simplifying or not an option (default nil?)
       ((mv erp dag-or-quotep state)
        (if simplifyp
            (progn$ (cw "(We begin by simplifying the goal:~%") ;(give the reason)?
                    ;; initial-rule-set(s) take precedence here, if supplied (fixme what if both are supplied?)
                    ;; (and monitored-symbols (cw "Monitored symbols: ~x0." monitored-symbols)) ;printed by simp-dag?
                    (if initial-rule-set
                        (simp-dag dag
                                  :rule-alist (make-rule-alist-simple initial-rule-set t (table-alist 'axe-rule-priorities-table (w state)))
                                  :interpreted-function-alist interpreted-function-alist
                                  :assumptions assumptions
                                  :print print ;;(and print :brief)
                                  :monitor monitored-symbols
                                  :normalize-xors normalize-xors
                                  :memoizep (not use-context-when-miteringp)
                                  :use-internal-contextsp use-context-when-miteringp ;think about this..
                                  :work-hard-when-instructedp nil
                                  :check-inputs nil)
                      (if initial-rule-sets
                          (simp-dag dag
                                    :rule-alists (make-rule-alists-simple initial-rule-sets t (table-alist 'axe-rule-priorities-table (w state)))
                                    :interpreted-function-alist interpreted-function-alist
                                    :assumptions assumptions
                                    :print print ;;(and print :brief)
                                    :monitor monitored-symbols
                                    :normalize-xors normalize-xors
                                    :memoizep (not use-context-when-miteringp)
                                    :use-internal-contextsp use-context-when-miteringp ;think about this..
                                    :work-hard-when-instructedp nil
                                    :check-inputs nil)
                        ;; no special initial rule-set(s) given:
                        (simp-dag dag
                                  :rule-alist rewriter-rule-alist
                                  :interpreted-function-alist interpreted-function-alist
                                  :assumptions assumptions
                                  :print print ;;(and print :brief)
                                  :monitor monitored-symbols
                                  :normalize-xors normalize-xors
                                  :memoizep (not use-context-when-miteringp)
                                  :use-internal-contextsp use-context-when-miteringp ;think about this..
                                  :work-hard-when-instructedp nil
                                  :check-inputs nil))))
          (prog2$ (cw "(We don't simplify the goal to start, because no rules are given.)~%")
                  (mv (erp-nil) dag state))))
       ((when erp) (mv erp nil nil state))
       ;;should we print the simplified dag?  we print it at the start of the sweep?
       (- (and simplifyp (cw "Done simplifying.)~%"))))
    (if (quotep dag-or-quotep)
        ;; the simplified DAG is a quotep:
        (if (equal *t* dag-or-quotep) ; todo: allow any non-nil constant?
            (prog2$ (cw "The DAG has been rewritten to true!)~%") ;move this message?
                    (mv (erp-nil) t all-untranslated-assumptions state))
          (prog2$ (er hard? 'prove-with-axe-core "Tried to prove the goal is t, but it's the non-t constant ~x0" dag-or-quotep)
                  (mv :non-t-constant nil nil state)))
      ;; Did not simplify to a constant:
      (b* ((dag dag-or-quotep)
           ((when (eq :rewrite tactic))
            (cw "DAG for error message below:~%")
            (print-list dag)             ; always print the DAG
            (if (< (dag-size dag) 10000) ; print the term too, if small
                (cw "~%(Term: ~X01)~%" (dag2term dag) nil)
              nil)
            (er hard? 'prove-with-axe-core "If the tactic is :rewrite, the DAG must simplify to true, but it simplified to the above. Functions in the DAG: ~X01" (dag-fns dag) nil)
            (mv :no-test-cases nil nil state))
           ;; Tactic is :rewrite-and-sweep:
           (state (if (and simplifyp (print-level-at-least-tp print))
                      (print-dag-to-temp-file dag (symbol-name (pack$ proof-name '-after-initial-simplification)) state)
                    state))
           ;;(state (f-put-global 'fmt-hard-right-margin 197 state)) fixme illegal in ACL2 4.3. work around?
           ;;(state (f-put-global 'fmt-soft-right-margin 187 state))
           (state (submit-event-quiet '(set-inhibit-warnings "double-rewrite" "subsume") state)) ; move up?

           ;;(prog2$ (mv nil state rand))
           ;; Specialize the fns (make use of constant arguments, when possible) ;do we still need this, if we have the dropping stuff?  maybe this works for head recfns too?
           ;;(how well does this work?): redo it to preserve lambdas (just substitute in them?)
           ((mv erp dag-or-quotep interpreted-function-alist state)
            (if (not specialize-fnsp)
                (mv (erp-nil) dag interpreted-function-alist state)
              (prog2$
                (cw "(Specializing fns:~%")
                (mv-let (erp new-function-names new-rule-names state)
                  (specialize-fns dag state)
                  (if erp
                      (mv erp nil nil state)
                    (prog2$ (cw "(Rewriting to introduce specialized functions.~%")
                            (mv-let (erp dag state)
                              (quick-simp-dag dag ;fixme - use some more rules?!
                                              :rules new-rule-names ;ffffixme return new-rule-names ?
                                              :print :brief)
                              (if erp
                                  (mv erp nil nil state)
                                (let ((interpreted-function-alist
                                        (add-fns-to-interpreted-function-alist new-function-names interpreted-function-alist (w state))))
                                  (prog2$ (cw "Done rewriting to introduce specialized functions.)~%Done specializing.)~%")
                                          (mv (erp-nil) dag interpreted-function-alist state)))))))))))
           ((when erp) (mv erp nil nil state))
           ((when (quotep dag-or-quotep))
            (if (equal *t* dag-or-quotep) ; todo: allow any non-nil constant?
                (prog2$ (cw "The DAG has been rewritten to true!)~%") ;move this message?
                        (mv (erp-nil) t all-untranslated-assumptions state))
              (prog2$ (er hard? 'prove-with-axe-core "Tried to prove the goal is t, but it's the non-t constant ~x0" dag-or-quotep)
                      (mv :non-t-constant nil nil state))))
           (dag dag-or-quotep) ; it wasn't a quotep
           ;; Generate test-inputs:     ;;todo: rename test-cases test-inputs?
           ((mv erp test-cases)
            ;; Make the random test cases (each assigns values to the input vars):
            ;;todo: consider waiting on this until we see how many we need?  consider making targeted test cases to try to make certain nodes not :unused?
            ;; This drops cases that don't satisfy the assumptions (but what if none survive?):
            (make-test-cases test-case-count test-case-type-alist assumptions random-seed))
           ((when erp) (mv erp nil nil state))
           ;; todo: should we move any stuff above here into miter-and-merge (like, specialize and/or the pre-simplify)?
           ((mv erp provedp state)
            (with-local-stobj
              rand
              (mv-let (erp provedp rand state)
                (miter-and-merge dag
                                 proof-name ; move later in arg list
                                 0
                                 var-type-alist
                                 interpreted-function-alist print debug-nodes
                                 rewriter-rule-alist
                                 prover-rule-alist
                                 assumptions
                                 extra-stuff
                                 test-cases
                                 monitored-symbols
                                 use-context-when-miteringp
                                 (empty-analyzed-function-table)
                                 unroll
                                 tests-per-case
                                 (if (eq :auto max-conflicts) *default-stp-max-conflicts* max-conflicts)
                                 t ;must-succeedp=t
                                 pre-simplify-rec-fnsp
                                 normalize-xors
                                 ;; could move more stuff into these options:
                                 (s :prove-constants prove-constants nil)
                                 rand state)
                (mv erp provedp state))))
           ((when erp) (mv erp nil nil state)))
        (if provedp
            (prog2$ (cw "Finished proving top-level goal!)~%")
                    (mv (erp-nil) t  all-untranslated-assumptions state))
          (prog2$ (cw "failed to prove by mitering and merging.)") ;todo: error or not?
                  (mv (erp-nil) nil all-untranslated-assumptions state)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Returns (mv erp event state) where ERP is non-nil iff
;; we failed to reduce the miter to T.
(defun prove-with-axe-fn (dag-or-term
                          assumptions ; (untranslated) terms we can assume are true (non-nil)
                          types
                          interpreted-function-alist
                          test-types
                          tests ; the total number of tests to generate?  some may not be used
                          tactic
                          print
                          debug-nodes
                          ;; todo: allow the use of rule phases?!
                          runes          ;used for both the rewriter and prover
                          rules          ;used for both the rewriter and prover
                          rewriter-runes ;used for the rewriter only (not the prover)
                          prover-runes ;used for the prover only (not the rewriter) ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                          initial-rule-set
                          initial-rule-sets
                          pre-simplify-rec-fnsp
                          extra-stuff
                          specialize-fnsp
                          monitored-symbols
                          use-context-when-miteringp
                          random-seed
                          unroll
                          tests-per-case
                          max-conflicts
                          normalize-xors
                          prove-constants
                          proof-name
                          keep-temp-dir whole-form state)
  (declare (xargs :guard (and ;; dag-or-term is a dag or (untranslated) term
                              (true-listp assumptions) ; untranslated
                              (or (eq :bits types)
                                  (eq :bytes types)
                                  (and (var-type-alistp types)
                                       (no-duplicatesp (strip-cars types))
                                       (not (assoc-eq nil types)) ;consider relaxing this?
                                       (not (assoc-eq t types)) ;consider relaxing this?
                                       ))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-case-type-alistp test-types)
                              (natp tests)
                              (or (eq tactic :rewrite)
                                  (eq tactic :rewrite-and-sweep))
                              (print-levelp print)
                              (nat-listp debug-nodes)
                              (symbol-listp runes)
                              (axe-rule-listp rules)
                              (symbol-listp rewriter-runes)
                              (symbol-listp prover-runes)
                              (axe-rule-listp initial-rule-set)
                              (all-axe-rule-listp initial-rule-sets)
                              (not (and initial-rule-set initial-rule-sets)) ;it would be ambiguous which one to use
                              (booleanp pre-simplify-rec-fnsp)
                              (if (extra-stuff-okayp extra-stuff)
                                  t
                                (prog2$ (cw "Extra stuff not okay: ~x0" extra-stuff) ;drop?
                                        nil))
                              (booleanp specialize-fnsp)
                              (symbol-listp monitored-symbols)
                              (booleanp use-context-when-miteringp)
                              (or (null random-seed)
                                  (natp random-seed))
                              ;;:unroll is either a list of function names to unroll (can be empty), or :all
                              (or (eq :all unroll)
                                  (symbol-listp unroll))
                              (natp tests-per-case)
                              (or (eq :auto max-conflicts)
                                  (null max-conflicts)
                                  (natp max-conflicts))
                              (booleanp normalize-xors)
                              (booleanp prove-constants)
                              (symbolp proof-name)
                              (member-eq keep-temp-dir '(t nil :auto)))
                  :mode :program
                  :stobjs state))
  (b* (;; Handle redundant invocation:
       ((when (command-is-redundantp whole-form state))
        (mv (erp-nil) '(value-triple :invisible) state))
       (- (cw "(Proving equivalence:~%"))
       ;; Start timing:
       ((mv start-real-time state) (get-real-time state)) ; we use wall-clock time so that time in STP is counted
       ;; Make term args (if present) into a DAG:
       (wrld (w state))
       ((mv erp dag-or-quotep) (dag-or-term-to-dag dag-or-term wrld))
       ((when erp) (mv erp nil state))
       ;; Choose a name for the miter:
       (dag-or-term-form (farg1 whole-form))
       (proof-name (choose-proof-name proof-name dag-or-term-form (w state)))
       ;; Do the proof:
       ((mv erp provedp & ;all-assumptions
            state)
        (prove-with-axe-core dag-or-quotep
                             assumptions
                             types
                             interpreted-function-alist
                             test-types
                             tests
                             tactic
                             print
                             debug-nodes
                             ;; todo: allow the use of rule phases?!
                             runes      ;used for both the rewriter and prover
                             rules      ;used for both the rewriter and prover
                             rewriter-runes ;used for the rewriter only (not the prover)
                             prover-runes ;used for the prover only (not the rewriter) ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                             initial-rule-set
                             initial-rule-sets
                             pre-simplify-rec-fnsp
                             extra-stuff
                             specialize-fnsp
                             monitored-symbols ;check these and maybe flesh out symbols into runes? or just use a list of symbols?
                             use-context-when-miteringp
                             random-seed
                             unroll
                             tests-per-case
                             max-conflicts
                             normalize-xors
                             prove-constants
                             proof-name state))
       ;; Remove the temp-dir (usually):
       (state (maybe-remove-temp-dir2 keep-temp-dir erp nil state))
       ((when erp) (prog2$ (er hard? 'prove-with-axe-fn "ERROR in proof ~x0: ~x1.~%" proof-name erp)
                           (mv erp nil state)))
       ((when (not provedp)) (prog2$ (er hard? 'prove-with-axe-fn "Proof attempt failed.~%")
                                     (mv :proof-failed nil state)))
       ((mv elapsed state) (real-time-since start-real-time state))
       (- (cw "~%PROOF SUCCEEDED IN ")
          (print-to-hundredths elapsed)
          (cw "s.)~%"))
       ;; Assemble the event to return:
       (event '(progn)) ; empty progn to be extended
       ;;todo: should return a theorem about the term-or-dag!
       ;; Table event for redundancy checking:
       (event (extend-progn event `(with-output :off :all (table prove-with-axe-table ',whole-form ',event))))
       ;; Arrange to print the miter name when the event is submitted:
       (event (extend-progn event `(value-triple :invisible))))
    (mv (erp-nil) event state)))

;; Returns (mv erp event state).
; todo: eventually, try to always use the same rules for the dag prover as the dag rewriter..
;fixme - need to gather up and return the events created, since make-event protects the logical world..
;BOZO consider changing the default for cut-proofs...- huh?
;;EXTRA-HYPS is an alist from theorem-names (without mention of hides) to lists of hyps
;the variables in dag list should be the final ones (i.e., we shouldn't expect assumptions to introduce new vars)
;; This tool was formerly called prove-miter.
(defmacro prove-with-axe (&whole
                           whole-form
                           dag-or-quotep
                           &key
                           (assumptions 'nil) ; (untranslated) terms we can assume are true (non-nil)
                           (types 'nil)  ; gives types to the vars for the proofs
                           (interpreted-function-alist 'nil) ;affects soundness
                           (test-types 'nil) ; overrides types to give more restricted types for pre-sweep testing
                           (tests '50) ; (max) number of tests to run, if :tactic is :rewrite-and-sweep
                           (tactic ':rewrite-and-sweep)
                           (print ':brief)
                           (debug-nodes 'nil)
                           (runes 'nil) ;used for both the rewriter and prover, affects soundness
                           (rules 'nil) ;used for both the rewriter and prover, affects soundness
                           (rewriter-runes 'nil) ;used for the rewriter only (not the prover), affects soundness
                           (prover-runes 'nil) ;used for the prover only (not the rewriter), affects soundness ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                           (initial-rule-set 'nil)
                           (initial-rule-sets 'nil)
                           (pre-simplify-rec-fns 't) ;was nil
                           (extra-stuff 'nil) ;ffixme does any of this affect soundness?
                           (specialize-fnsp 'nil)
                           (monitor 'nil)         ;a list of runes
                           (use-context-when-miteringp 'nil) ;fffixme may cause huge blowups!  why? because memoization gets turned off?
                           (random-seed 'nil)
                           (unroll 'nil) ;fixme make :all the default (or should we use t instead of all?)
                           (tests-per-case '512)
                           (max-conflicts ':auto) ;initial value to use for max-conflicts (may be increased when there's nothing else to do), nil would mean don't use max-conflicts
                           (normalize-xors 't)
                           (prove-constants 't) ;whether to attempt to prove probably-constant nodes
                           (proof-name ':auto)
                           (keep-temp-dir ':auto))
  ;; note: we can't put a make-event inside an acl2-unwind-protect, so we do it
  ;; this way:
  `(make-event-quiet
     (acl2-unwind-protect ; enable cleanup on interrupt
       "acl2-unwind-protect for prove-with-axe"
       (prove-with-axe-fn ,dag-or-quotep ,assumptions ,types ,interpreted-function-alist ,test-types
                          ,tests ,tactic ,print ,debug-nodes ,runes ,rules ,rewriter-runes ,prover-runes
                          ,initial-rule-set ,initial-rule-sets ,pre-simplify-rec-fns ,extra-stuff ,specialize-fnsp ,monitor ,use-context-when-miteringp
                          ,random-seed ,unroll ,tests-per-case ,max-conflicts ,normalize-xors ,prove-constants ,proof-name ,keep-temp-dir
                          ',whole-form state)
       ;; ;; Can't call prove-with-axe-fn directly here, because it returns extra
       ;; ;; stobjs (does not return an error triple), so we use trans-eval as
       ;; ;; suggested by MK:
       ;; (mv-let (erp val state)
       ;;   (trans-eval-no-warning '(prove-with-axe-fn
       ;;                            ,dag-or-quotep ,assumptions ,types ,interpreted-function-alist ,test-types
       ;;                            ,tests ,tactic ,print ,debug-nodes ,runes ,rules ,rewriter-runes ,prover-runes
       ;;                            ,initial-rule-set ,initial-rule-sets ,pre-simplify-rec-fns ,extra-stuff ,specialize-fnsp ,monitor ,use-context-when-miteringp
       ;;                            ,random-seed ,unroll ,tests-per-case ,max-conflicts ,normalize-xors ,prove-constants ,proof-name ,keep-temp-dir
       ;;                            ',whole-form state)
       ;;                          'prove-with-axe
       ;;                          state
       ;;                          t)
       ;;   (if erp
       ;;       ;; error translating (should not happen):
       ;;       (mv erp nil state)
       ;;     (let* ( ;; (stobjs-out (car val))
       ;;            (values-returned (cdr val))
       ;;            ;; Get the non-stobj values returned by prove-with-axe-fn:
       ;;            (erp (first values-returned))
       ;;            (event (second values-returned)))
       ;;       (mv erp event state))))

       ;; The acl2-unwind-protect ensures that this is called if the user interrupts:
       ;; Remove the temp-dir (usually):
       (maybe-remove-temp-dir2 ,keep-temp-dir nil t state)
       ;; No need to clean up anything if no interrupt and no error:
       state)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Returns (mv erp event state).
(defun prove-equal-with-axe+-fn (dag-or-term1
                                 dag-or-term2
                                 assumptions ; (untranslated) terms we can assume are true (non-nil)
                                 types
                                 interpreted-function-alist
                                 test-types
                                 tests
                                 tactic
                                 print debug-nodes runes rules rewriter-runes prover-runes initial-rule-set initial-rule-sets
                                 pre-simplify-rec-fnsp extra-stuff specialize-fnsp
                                 monitored-symbols use-context-when-miteringp
                                 random-seed unroll tests-per-case
                                 max-conflicts normalize-xors prove-constants
                                 proof-name
                                 keep-temp-dir
                                 check-vars
                                 whole-form state)
  (declare (xargs :guard (and (true-listp assumptions) ; untranslated
                              (or (eq :bits types)
                                  (eq :bytes types)
                                  (and (var-type-alistp types)
                                       (no-duplicatesp (strip-cars types))
                                       (not (assoc-eq nil types)) ;consider relaxing this?
                                       (not (assoc-eq t types)) ;consider relaxing this?
                                       ))
                              (interpreted-function-alistp interpreted-function-alist)
                              (test-case-type-alistp test-types)
                              (natp tests)
                              (or (eq tactic :rewrite)
                                  (eq tactic :rewrite-and-sweep))
                              (print-levelp print)
                              (nat-listp debug-nodes)
                              (symbol-listp runes)
                              (axe-rule-listp rules)
                              (symbol-listp rewriter-runes)
                              (symbol-listp prover-runes)
                              (axe-rule-listp initial-rule-set)
                              (all-axe-rule-listp initial-rule-sets)
                              (not (and initial-rule-set initial-rule-sets)) ;it would be ambiguous which one to use
                              (booleanp pre-simplify-rec-fnsp)
                              (if (extra-stuff-okayp extra-stuff)
                                  t
                                (prog2$ (cw "Extra stuff not okay: ~x0" extra-stuff) ;drop?
                                        nil))
                              (booleanp specialize-fnsp)
                              (symbol-listp monitored-symbols)
                              (booleanp use-context-when-miteringp)
                              (or (null random-seed)
                                  (natp random-seed))
                              ;;:unroll is either a list of function names to unroll (can be empty), or :all
                              (or (eq :all unroll)
                                  (symbol-listp unroll))
                              (natp tests-per-case)
                              (or (eq :auto max-conflicts)
                                  (null max-conflicts)
                                  (natp max-conflicts))
                              (booleanp normalize-xors)
                              (booleanp prove-constants)
                              (symbolp proof-name)
                              (member-eq keep-temp-dir '(t nil :auto))
                              (member-eq check-vars '(t nil :warn)))
                  :mode :program
                  :stobjs state))
  (b* (;; Handle redundant invocation:
       ((when (command-is-redundantp whole-form state))
        (mv (erp-nil) '(value-triple :invisible) state))
       (- (cw "(Proving equivalence:~%"))
       ;; Start timing:
       ((mv start-real-time state) (get-real-time state)) ; we use wall-clock time so that time in STP is counted
      ;; Make term args (if any) into DAGs:
       (wrld (w state))
       ((mv erp dag-or-quotep1) (dag-or-term-to-dag dag-or-term1 wrld))
       ((when erp) (mv erp nil state))
       ((mv erp dag-or-quotep2) (dag-or-term-to-dag dag-or-term2 wrld))
       ((when erp) (mv erp nil state))
       ;; Compute and check var lists:
       (- (maybe-check-dag-vars check-vars dag-or-quotep1 dag-or-quotep2 'prove-equal-with-axe+-fn))
       ;; Make the equality DAG: ; TODO: Consider which DAG to add first
       ((mv erp equality-dag-or-quotep) (make-equality-dag dag-or-quotep1 dag-or-quotep2))
       ((when erp) (mv erp nil state))
       ;; Choose a name for the miter:
       (dag-or-term-form1 (farg1 whole-form))
       (dag-or-term-form2 (farg2 whole-form))
       (proof-name (choose-equality-proof-name proof-name dag-or-term-form1 dag-or-term-form2 wrld))
       ;; Do the proof:
       ((mv erp provedp & ;all-assumptions
            state)
        (prove-with-axe-core equality-dag-or-quotep
                             assumptions
                             types
                             interpreted-function-alist
                             test-types
                             tests
                             tactic
                             print
                             debug-nodes
                             ;; todo: allow the use of rule phases?!
                             runes      ;used for both the rewriter and prover
                             rules      ;used for both the rewriter and prover
                             rewriter-runes ;used for the rewriter only (not the prover)
                             prover-runes ;used for the prover only (not the rewriter) ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                             initial-rule-set
                             initial-rule-sets
                             pre-simplify-rec-fnsp
                             extra-stuff
                             specialize-fnsp
                             monitored-symbols ;check these and maybe flesh out symbols into runes? or just use a list of symbols?
                             use-context-when-miteringp
                             random-seed
                             unroll
                             tests-per-case
                             max-conflicts
                             normalize-xors
                             prove-constants
                             proof-name state))
       ;; Remove the temp-dir (usually):
       (state (maybe-remove-temp-dir2 keep-temp-dir erp nil state))
       ((when erp) (prog2$ (er hard? 'prove-equal-with-axe+-fn "ERROR in proof ~x0: ~x1.~%" proof-name erp)
                           (mv erp nil state)))
       ((when (not provedp)) (prog2$ (er hard? 'prove-equal-with-axe+-fn "Proof attempt failed.~%")
                                     (mv :proof-failed nil state)))
       ((mv elapsed state) (real-time-since start-real-time state))
       (- (cw "~%PROOF OF EQUIVALENCE SUCCEEDED IN ")
          (print-to-hundredths elapsed)
          (cw "s.)~%"))
       ;; Assemble the event to return:
       (event '(progn)) ; empty progn to be extended
       ;;todo: should return a theorem about the term-or-dags!
       ;; Table event for redundancy checking:
       (event (extend-progn event `(with-output :off :all (table prove-equal-with-axe+-table ',whole-form ',event))))
       ;; Arrange to print the miter name when the event is submitted:
       (event (extend-progn event `(value-triple :invisible))))
    (mv (erp-nil) event state)))

;; Unlike prove-with-axe, this takes 2 terms/dags.  unlike prove-equal-with-axe, this supports all the exotic options to prove-with-axe.
;; Used in several loop examples.
;; See also prove-equal-with-axe, which is preferable when it is sufficient (because it is simpler).
;; This tool was formerly called prove-equality.
  ;;TODO: error or warning if :tactic is rewrite and :tests is given?
(defmacro prove-equal-with-axe+ (&whole
                                  whole-form
                                  dag-or-term1
                                  dag-or-term2
                                  &key
                                  (assumptions 'nil) ; (untranslated) terms we can assume are true (non-nil)
                                  (types 'nil) ; gives types to the vars for the proofs
                                  (interpreted-function-alist 'nil) ;affects soundness
                                  (test-types 'nil) ; overrides types to give more restricted types for pre-sweep testing
                                  (tests '50) ; (max) number of tests to run, if :tactic is :rewrite-and-sweep
                                  (tactic ':rewrite-and-sweep)
                                  (print ':brief)
                                  (debug-nodes 'nil)
                                  (runes 'nil) ;used for both the rewriter and prover, affects soundness
                                  (rules 'nil) ;used for both the rewriter and prover, affects soundness
                                  (rewriter-runes 'nil) ;used for the rewriter only (not the prover), affects soundness
                                  (prover-runes 'nil) ;used for the prover only (not the rewriter), affects soundness ;; it may be okay to put more expensive rules (e.g., those that split into cases here?)
                                  (initial-rule-set 'nil)
                                  (initial-rule-sets 'nil)
                                  (pre-simplify-rec-fns 't) ;was nil
                                  (extra-stuff 'nil) ;ffixme does any of this affect soundness?
                                  (specialize-fnsp 'nil)
                                  (monitor 'nil)         ;a list of runes
                                  (use-context-when-miteringp 'nil) ;fffixme may cause huge blowups!  why? because memoization gets turned off?
                                  (random-seed 'nil)
                                  (unroll 'nil) ;fixme make :all the default (or should we use t instead of all?)
                                  (tests-per-case '512)
                                  (max-conflicts ':auto) ;initial value to use for max-conflicts (may be increased when there's nothing else to do), nil would mean don't use max-conflicts
                                  (normalize-xors 't)
                                  (prove-constants 't) ;whether to attempt to prove probably-constant nodes
                                  (proof-name ':auto)
                                  (keep-temp-dir ':auto)
                                  (check-vars 't))
  `(make-event-quiet
     (acl2-unwind-protect ; enable cleanup on interrupt
       "acl2-unwind-protect for prove-equal-with-axe+"
       (prove-equal-with-axe+-fn ,dag-or-term1
                                 ,dag-or-term2
                                 ,assumptions ,types ,interpreted-function-alist ,test-types ,tests ,tactic
                                 ,print ,debug-nodes ,runes ,rules ,rewriter-runes ,prover-runes ,initial-rule-set ,initial-rule-sets
                                 ,pre-simplify-rec-fns ,extra-stuff ,specialize-fnsp
                                 ,monitor ,use-context-when-miteringp
                                 ,random-seed ,unroll ,tests-per-case
                                 ,max-conflicts ,normalize-xors ,prove-constants
                                 ,proof-name
                                 ,keep-temp-dir
                                 ,check-vars
                                 ',whole-form state)
       ;; The acl2-unwind-protect ensures that this is called if the user interrupts:
       ;; Remove the temp-dir (usually):
       (maybe-remove-temp-dir2 ,keep-temp-dir nil t state)
       ;; No need to clean up anything if no interrupt and no error:
       state)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Nicer wrappers for the miter proofs (TODO: use these everywhere)

;; Returns (mv erp event state).
;; TODO: Build the types from the assumptions or vice versa (types for testing may have additional restrictions to avoid huge inputs)
(defun prove-equal-with-axe-fn (dag-or-term1
                                dag-or-term2
                                assumptions ; (untranslated) terms we can assume are true (non-nil)
                                types
                                interpreted-function-alist
                                test-types
                                tests ;a natp indicating how many tests to run
                                tactic
                                print
                                debug-nodes
                                extra-rules remove-rules initial-rule-sets ;; these differ from prove-equal-with-axe+
                                monitored-symbols use-context-when-miteringp
                                random-seed
                                ;;;
                                max-conflicts normalize-xors prove-constants
                                proof-name  ; may be :auto
                                keep-temp-dir
                                check-vars
                                prove-theorem ;; todo: add to other tools?
                                local ;; todo: add to other tools?
                                whole-form
                                state)
  (declare (xargs :guard (and ;; dag-or-term1 is a DAG or (untranslated) term
                           ;; dag-or-term2 is a DAG or (untranslated) term
                           (true-listp assumptions) ; untranslated
                           (or (eq :bits types) ; todo: consider supporting other things, like :u32
                               (eq :bytes types)
                               (and (var-type-alistp types)
                                    (no-duplicatesp (strip-cars types))
                                    (not (assoc-eq nil types)) ;consider relaxing this?
                                    (not (assoc-eq t types)) ;consider relaxing this?
                                    ))
                           (interpreted-function-alistp interpreted-function-alist)
                           (test-case-type-alistp test-types)
                           (natp tests)
                           (or (eq tactic :rewrite)
                               (eq tactic :rewrite-and-sweep))
                           (print-levelp print)
                           (nat-listp debug-nodes)
                           (or (eq :auto max-conflicts)
                               (null max-conflicts)
                               (natp max-conflicts))
                           (symbol-listp extra-rules)
                           (symbol-listp remove-rules)
                           (or (eq :auto initial-rule-sets)
                               (axe-rule-setsp initial-rule-sets))
                           (symbol-listp monitored-symbols)
                           (booleanp use-context-when-miteringp)
                           (or (null random-seed)
                               (natp random-seed))
                           (booleanp normalize-xors)
                           (booleanp prove-constants)
                           (symbolp proof-name)
                           (member-eq keep-temp-dir '(t nil :auto))
                           (member-eq check-vars '(t nil :warn))
                           (booleanp prove-theorem)
                           (booleanp local))
                  :mode :program
                  :stobjs state))
  (b* (;; Handle redundant invocation:
       ((when (command-is-redundantp whole-form state))
        (mv (erp-nil) '(value-triple :redundant) state))
       (- (cw "(Proving equivalence:~%"))
       ;; Start timing:
       ((mv start-real-time state) (get-real-time state)) ; we use wall-clock time so that time in STP is counted
       ;; Make term args (if any) into DAGs:
       (wrld (w state))
       ((mv erp dag-or-quotep1) (dag-or-term-to-dag dag-or-term1 wrld))
       ((when erp) (mv erp nil state))
       ((mv erp dag-or-quotep2) (dag-or-term-to-dag dag-or-term2 wrld))
       ((when erp) (mv erp nil state))
       ;; Compute and check var lists:
       (- (maybe-check-dag-vars check-vars dag-or-quotep1 dag-or-quotep2 'prove-equal-with-axe-fn))
       ;; Make the equality DAG: ; TODO: Consider which DAG to add first
       ((mv erp equality-dag-or-quotep) (make-equality-dag dag-or-quotep1 dag-or-quotep2)) ; todo: check for constant result and finish immediately
       ((when erp) (mv erp nil state))
       ;; Make the initial rule sets:
       ((mv erp initial-rule-sets) (if (eq :auto initial-rule-sets)
                                       ;;todo: make this a named rule set:
                                       (add-rules-to-rule-sets (list-rules)
                                                               (phased-bv-axe-rule-sets state) wrld) ;todo: overkill?
                                     (mv (erp-nil) initial-rule-sets)))
       ((when erp) (mv erp nil state))
       ;; Always add the extra-rules:
       ((mv erp initial-rule-sets) (if initial-rule-sets
                                       (add-rules-to-rule-sets extra-rules initial-rule-sets wrld)
                                     ;; special case: no initial-rule-sets, but extra-rules are given (TODO: Think about this):
                                     (add-rules-to-rule-sets extra-rules (list nil) wrld)))
       ((when erp) (mv erp nil state))
       ;; Then remove the remove-rules:
       (initial-rule-sets (if remove-rules (remove-rules-from-rule-sets remove-rules initial-rule-sets) initial-rule-sets))
       ;; Choose a name for the miter:
       (dag-or-term-form1 (farg1 whole-form)) ; todo: why "quoted"?
       (dag-or-term-form2 (farg2 whole-form))
       (proof-name (choose-equality-proof-name proof-name dag-or-term-form1 dag-or-term-form2 wrld))
       ;; Try to prove the equality:
       ((mv erp provedp all-assumptions state)
        (prove-with-axe-core equality-dag-or-quotep
                             assumptions
                             types
                             interpreted-function-alist
                             test-types
                             tests ; number of tests to run
                             tactic
                             print
                             debug-nodes
                             nil ;runes
                             nil ;rules
                             nil ;rewriter-runes
                             nil ;prover-runes
                             nil ;initial-rule-set
                             initial-rule-sets
                             t   ;pre-simplify-rec-fnsp ; todo: try nil
                             nil ;extra-stuff
                             nil ;specialize-fnsp
                             monitored-symbols
                             use-context-when-miteringp
                             random-seed
                             nil ;unroll
                             512 ; tests-per-case
                             max-conflicts
                             normalize-xors
                             prove-constants
                             proof-name state))
       ;; Remove the temp-dir (usually):
       (state (maybe-remove-temp-dir2 keep-temp-dir erp nil state))
       ((when erp) (prog2$ (er hard? 'prove-equal-with-axe-fn "ERROR in proof ~x0: ~x1.~%" proof-name erp)
                           (mv erp nil state)))
       ((when (not provedp)) (prog2$ (er hard? 'prove-equal-with-axe-fn "Proof attempt failed.~%")
                                     (mv :proof-failed nil state)))
       ((mv elapsed state) (real-time-since start-real-time state))
       (- (cw "~%PROOF OF EQUIVALENCE SUCCEEDED IN ")
          (print-to-hundredths elapsed)
          (cw "s.)~%"))
       ;; Assemble the event to return:
       (event '(progn)) ; empty progn to be extended
       ;; Maybe add the theorem to the progn:
       (event (if prove-theorem
                  (let* ((term1 (dag-or-term-to-term dag-or-term1 state))
                         (term2 (dag-or-term-to-term dag-or-term2 state))
                         (defthm `(skip-proofs ;todo: have prove-with-axe return a theorem and use it to prove this.  better yet, prove the theorem via a trusted-clause-processor
                                    ; todo: :rule-classes
                                    (defthmd ,proof-name
                                      (implies (and ,@all-assumptions) ; todo; clean up if none or one
                                               (equal ,term1
                                                      ,term2))))))
                    (extend-progn event defthm))
                event))
       ;; Table event for redundancy checking:
       (event (extend-progn event `(with-output :off :all (table prove-equal-with-axe-table ',whole-form ',event))))
       ;; Arrange to print the miter name when the event is submitted:
       (event (extend-progn event `(value-triple :invisible)))
       ;; Make the whole thing local if instructed:
       (event (if local `(local ,event) event)))
    (mv (erp-nil) event state)))

;; This tool was formerly called prove-equivalence.
(defmacrodoc prove-equal-with-axe (&whole
                                    whole-form
                                    dag-or-term1
                                    dag-or-term2
                                    &key
                                    (assumptions 'nil) ; (untranslated) terms we can assume are true (non-nil)
                                    (types 'nil) ; gives types to the vars for the proofs
                                    (interpreted-function-alist 'nil) ;affects soundness
                                    (test-types 'nil) ; overrides types to give more restricted types for pre-sweep testing
                                    (tests '50) ; (max) number of tests to run, if :tactic is :rewrite-and-sweep
                                    (tactic ':rewrite-and-sweep)
                                    (print ':brief)
                                    (debug-nodes 'nil)
                                    (extra-rules 'nil)
                                    (remove-rules 'nil)
                                    (initial-rule-sets ':auto)
                                    (monitor 'nil)
                                    (use-context-when-miteringp 'nil) ;todo: try t
                                    (random-seed 'nil)
                                    (max-conflicts ':auto) ;1000 here broke proofs
                                    (normalize-xors 't)
                                    (prove-constants 't)
                                    (proof-name ':auto) ;the name of the proof, if we care to give it one.  also used for the name of the theorem.  :auto means try to create a name from the defconsts provided
                                    (keep-temp-dir ':auto)
                                    (check-vars 't)
                                    (prove-theorem 'nil) ; very rarely used
                                    (local 't))
  `(make-event-quiet
     (acl2-unwind-protect ; enable cleanup on interrupt
       "acl2-unwind-protect for prove-equal-with-axe"
       (prove-equal-with-axe-fn ,dag-or-term1 ,dag-or-term2 ,assumptions ,types ,interpreted-function-alist ,test-types ,tests ,tactic
                                ,print ,debug-nodes ,extra-rules ,remove-rules ,initial-rule-sets
                                ,monitor ,use-context-when-miteringp ,random-seed
                                ,max-conflicts ,normalize-xors ,prove-constants
                                ,proof-name ,keep-temp-dir ,check-vars
                                ,prove-theorem ,local ',whole-form state)
       ;; The acl2-unwind-protect ensures that this is called if the user interrupts:
       ;; Remove the temp-dir (usually):
       (maybe-remove-temp-dir2 ,keep-temp-dir nil t state)
       ;; No need to clean up anything if no interrupt and no error:
       state))
  :parents (axe-core axe-provers)
  :short "A tool for proving that DAGs / terms are equivalent."
  :args ((dag-or-term1 "The first DAG or term to compare")
         (dag-or-term2 "The second DAG or term to compare")
         (assumptions "Assumptions to use when proving equivalence, a list of terms (not necessarily translated).  The proof is done assuming all of the :assumptions are non-nil.")
         (types "A var-type-alist (alist mapping variables to their axe-types), or one of the special values :bits or :bytes.  The proof is done assuming the variables have their associated types.  Entries in this alist can be overridden for testing purposes by the :test-types option.")
         (interpreted-function-alist "Provides definitions for non-built-in functions.  An alist mapping function symbols to their bodies.")
         (test-types "Overrides of the :types for use in the testing that identifies probable facts for sweeping-and-merging (example, to restrict the length of arrays).")
         (tests "How many tests to use to find internal equivalences (a natp)")
         (tactic "Proof tactic to use for the proof (either :rewrite or :rewrite-and-sweep)")
         (print "Print verbosity (allows nil, :brief, t, and :verbose)")
         (debug-nodes "Nodenums whose values should be printed for each test-case, and whose subdags should be printing when attempting a merge.  These nodenums refer to the DAG used for sweeping-and-merging (after pre-simplification, etc, if any), specifically the DAG for the first sweep.")
         (extra-rules "A symbol list containing the names of extra rules to use when simplifying")
         (remove-rules "A symbol list containing the names of rules to be removed from the set of rules used when simplifying")
         (initial-rule-sets "Sequence of rule-sets to apply initially to simplify the miter (:auto means used phased-bv-axe-rule-sets)")
         (monitor "Rule names (symbols) to monitor when rewriting")
         (use-context-when-miteringp "Whether to use over-arching context when rewriting nodes (causes memoization to be turned off)")
         (random-seed "Seed for the random number generator used to make test cases, or nil meaning use the default.")
         (max-conflicts "Initial value of STP max-conflicts (number of conflicts), or :auto (meaning use the default of 60000), or nil (meaning no maximum).")
         (normalize-xors "Whether to normalize XOR nests when simplifying")
         (prove-constants "Whether, when sweeping, to try to prove nodes are constants (and replace them with those constants if the proof succeeds).")
         (proof-name "A name to assign to the proof, if desired.  A symbol, or :auto to let Axe choose a name.")
         (keep-temp-dir "Whether to keep the directory with temp files in place, for debugging.  If :auto, the temp-dir is kept whenever there is an error.")
         (check-vars "Whether to check that the two DAGs/terms have exactly the same vars.  Can be t (throw an error if the var lists differ), nil (do not check the var lists), or :warn (print a warning if the var lists differ but then continue).")
         (prove-theorem "Whether to produce an ACL2 theorem stating the equivalence (using skip-proofs, currently)")
         (local "whether to make the generated events local"))
  :description ("The equivalence claim to be proved is universally quantified over all values of the variables in the two terms/DAGs."
                "If the call to @('prove-equal-with-axe') completes without error, the DAG/terms are equal, given the :assumptions (including the :types)."
                "Usually, the two items (DAGs or terms) have the same set of free variables."
                "See also @('prove-equal-with-axe+'), for a variant that supports more exotic options."))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Cruft (delete after harvesting anything useful):

;;(axe-prover '((equal (car (cons x y)) x)) nil state)
;;(axe-prover '((not (equal w x)) (equal (car (cons x y)) w)) nil state)
;;(PROCESS-DAG-CLAUSE '((not (consp x)) (equal x (cons (car x) (cdr x)))))
;; (thm (equal (car (cons x y)) x)  :hints (("Goal" :in-theory (theory 'minimal-theory)
;;                                          :clause-processor axe-prover
;;                                          )))
;; (thm (implies (consp x) (equal x (cons (car x) (cdr x))))  :hints (("Goal" :in-theory (theory 'minimal-theory)
;;                                          :clause-processor axe-prover
;;                                          )))

;;   for each literal, assuming all the others are nodenums of non-nil expressions
;;     rewrite top-down?  use a worklist like the evaluator?
;;     if it rewrites to a nodenum, replace the old nodenum
;;     handle constants - non-nil proves the goal, nil is dropped
;;     what about conjunctions?

;; (thm
;;  (equal (car (cons x y)) x)
;;  :hints (("Goal" :in-theory (theory 'minimal-theory)
;;           :clause-processor axe-prover
;;           )))

;; (thm
;;  (implies (and (equal z x) (equal yy yyy))
;;           (equal (car (cons z y)) x))
;;  :hints (("Goal" :in-theory (theory 'minimal-theory)
;;           :clause-processor axe-prover
;;           )))


;; (defthm EVAL-GROUND-TERM-FOR-AXE-EVALUATOR-opener
;;   (implies (and (not (VARIABLEP FORM))
;;                 (not (FQUOTEP FORM)))
;;            (equal (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR ALIST FORM INTERPRETED-FUNCTION-ALIST)
;;                   (LET
;;                    ((FN (FFN-SYMB FORM)))
;;                    (IF
;;                     (OR (EQ FN 'IF) (EQ FN 'MYIF))
;;                     (LET* ((TEST (SECOND FORM))
;;                            (TEST-RESULT
;;                             (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR
;;                              ALIST TEST INTERPRETED-FUNCTION-ALIST)))
;;                           (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR
;;                            ALIST
;;                            (IF TEST-RESULT (THIRD FORM)
;;                                (FOURTH FORM))
;;                            INTERPRETED-FUNCTION-ALIST))
;;                     (LET
;;                      ((ARGS (EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR
;;                              ALIST (FARGS FORM)
;;                              INTERPRETED-FUNCTION-ALIST)))
;;                      (IF
;;                       (CONSP FN)
;;                       (LET* ((FORMALS (SECOND FN))
;;                              (BODY (THIRD FN))
;;                              (ALIST (PAIRLIS$ FORMALS ARGS)))
;;                             (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR
;;                              ALIST BODY INTERPRETED-FUNCTION-ALIST))
;;                       (LET*
;;                        ((RESULT
;;                          (AXE-EVALUATOR FN ARGS INTERPRETED-FUNCTION-ALIST))
;;                         (RESULT RESULT))
;;                        RESULT))))))))

;; (defthm EVAL-GROUND-TERM-FOR-AXE-EVALUATOR-when-quotep
;;   (implies (FQUOTEP FORM)
;;            (equal (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR ALIST FORM INTERPRETED-FUNCTION-ALIST)
;;                   (unquote form))))

;; (defthm eval-ground-term-for-axe-evaluator-when-variablep
;;   (implies (variablep form)
;;            (equal (eval-ground-term-for-axe-evaluator alist form interpreted-function-alist)
;;                   (CDR (ASSOC-EQUAL FORM ALIST)))))

;; (defthm consp-of-eval-ground-term-lst-for-axe-evaluator
;;   (implies (true-listp form-lst)
;;            (equal (consp (eval-ground-term-lst-for-axe-evaluator alist form-lst interpreted-function-alist))
;;                   (consp form-lst)))
;;   :hints (("Goal"
;;            :induct (true-listp FORM-LST)
;;            :in-theory (enable true-listp eval-ground-term-lst-for-axe-evaluator))))

;; (defthm cdr-of-eval-ground-term-lst-for-axe-evaluator
;;   (implies (true-listp form-lst)
;;            (equal (cdr (eval-ground-term-lst-for-axe-evaluator alist form-lst interpreted-function-alist))
;;                   (eval-ground-term-lst-for-axe-evaluator alist (cdr form-lst) interpreted-function-alist)))
;;   :hints (("Goal"
;;            :induct (true-listp FORM-LST)
;;            :in-theory (enable true-listp eval-ground-term-lst-for-axe-evaluator))))

;; (defthm nth-of-eval-ground-term-lst-for-axe-evaluator
;;   (implies (and (true-listp form-lst)
;;                 (natp n)
;;                 (< n (len form-lst)))
;;            (equal (nth n (eval-ground-term-lst-for-axe-evaluator alist form-lst interpreted-function-alist))
;;                   (eval-ground-term-for-axe-evaluator alist (nth n form-lst) interpreted-function-alist)))
;;   :hints (("Goal"
;;            :induct (indhhhh n FORM-LST)
;;            :expand (EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR
;;                     ALIST
;;                     FORM-LST INTERPRETED-FUNCTION-ALIST)
;;            :do-not '(generalize eliminate-destructors)
;;            :in-theory (enable NTH-OF-CONS true-listp NTH-OF-CONS-CONSTANT-VERSION NTH-0))))

;; (defthm EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR-opener
;;   (implies (not (endp form-lst))
;;            (equal (EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR ALIST FORM-LST INTERPRETED-FUNCTION-ALIST)
;;                   (CONS (EVAL-GROUND-TERM-FOR-AXE-EVALUATOR
;;                          ALIST (CAR FORM-LST)
;;                          INTERPRETED-FUNCTION-ALIST)
;;                         (EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR
;;                          ALIST (CDR FORM-LST)
;;                          INTERPRETED-FUNCTION-ALIST)))))

;; (defthm EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR-base
;;   (implies (endp form-lst)
;;            (equal (EVAL-GROUND-TERM-LST-FOR-AXE-EVALUATOR ALIST FORM-LST INTERPRETED-FUNCTION-ALIST)
;;                   nil)))


;assumptions are nodenums in the dag that can safely be assumed to be nil
;returns a nodenum or quotep equal to var (or returns nil to indicate failure)
;looks for assumptions of the form (not (equal term nodenum-or-quotep))
;; BBOZO sort the assumptions into those with LHSes that are vars and those with LHSes are conses
;if term is a function call, then the nodenums have already been simplified
;; (defun rewrite-term-using-assumptions-for-axe-prover (term assumptions dag-array)
;;   (if (endp assumptions)
;;       nil
;;     (let* ((nodenum (first assumptions))
;;            (expr (aref1 'dag-array dag-array nodenum)))
;;       (if (and (consp expr)
;;                (eq 'not (ffn-symb expr))
;;                (consp (second expr))
;;                (eq 'equal (ffn-symb (second expr)))
;;                (equal term (second (second expr))))
;;           (third (second expr))
;;         nil))))

;; ;term is a tree with nodenums and quoteps, quoteps, and variable at the leaves
;; (defun match-term-with-dag-expr (term expr dag-array)
;;   (if (symbolp term)
;;       (if (symbolp expr)
;;           (eq term expr)
;;         (if (atom expr)
;;             (let ((expr (aref1 'dag-array dag-array expr)))
;;               (eq term expr))
;;           nil))
;;     (if (atom term) ;nodenum
;;         (if (atom


;use this?

;; (defconst-computed *runes-for-axe-prover*
;;   (append (base-rules)
;;           '((:rewrite not-of-boolif)
;;             (:rewrite car-cons)
;;             (:rewrite equal-same)
;;             (:rewrite cons-car-cdr)
;;             (:definition implies)
;;             (:nil if-becomes-myif)
;; ;                             (:REWRITE MYIF-BECOMES-BOOLIF-t-ARG1)
;; ;                            (:REWRITE MYIF-BECOMES-BOOLIF-NIL-ARG1)
;; ;                           (:REWRITE MYIF-BECOMES-BOOLIF-t-ARG2)
;; ;                          (:REWRITE MYIF-BECOMES-BOOLIF-NIL-ARG2)
;;             )))

;; (mv-let (alist rand)
;;          (signature-alist *aes-128-encrypt-light-proof-dag* 40 rand)
;;          (mv (tag-probably-constant-nodes alist nil)
;;              rand))

;; (skip -proofs
;;  (mutual-recursion
;;   ;; nodenum2 is either a nodenum or a quotep
;;   (defun in-subdag-aux (nodenum1 nodenum2 dag-array nodes-checked)
;;     (if (consp nodenum2) ;amounts to checking quotep
;;         (mv nil nodes-checked)
;;       (if (eql nodenum1 nodenum2)
;;           (mv t nil) ;nodes-checked is irrelevant since we are returning t
;;         (if (< nodenum2 nodenum1) ;a larger node can't support a smaller node...
;;             (mv nil nodes-checked)
;;           (if (member nodenum2 nodes-checked)
;;               (mv nil nodes-checked)
;;             (let ((expr (aref1 'dag-array dag-array nodenum2)))
;;               (if (or (variablep expr)
;;                       (fquotep expr))
;;                   (mv nil (cons nodenum2 nodes-checked))
;;                 ;;otherwise, it's a function call
;;                 (in-subdag-aux-lst nodenum1 (fargs expr) dag-array (cons nodenum2 nodes-checked) ;okay to cons this on here, since there are no cycles?
;;                                    ))))))))

;;   ;; could optimize by checking for quoteps here?
;;   (defun in-subdag-aux-lst (nodenum1 items dag-array nodes-checked)
;;     (if (atom items)
;;         (mv nil nodes-checked)
;;       (mv-let (result nodes-checked)
;;               (in-subdag-aux nodenum1 (car items) dag-array nodes-checked)
;;               (if result
;;                   (mv t nil) ;nodes-checked is irrelevant since we are returning t
;;                 (in-subdag-aux-lst nodenum1 (cdr items) dag-array nodes-checked)))))))

;; (defun in-subdag (nodenum1 nodenum2 dag-array)
;;   (mv-let (result nodes-checked)
;;           (in-subdag-aux nodenum1 nodenum2 dag-array nil)
;;           (declare (ignore nodes-checked))
;;           result))


;find a set of nodes that fully supports nodenum1 (can be nodenum1 itself) and each of which supports nodenum2
;what if it's not possible? maybe we go all the way back to variables? could be super expensive in that case unless we memoize the nodes we've seen
;; (skip -proofs
;;  (mutual-recursion
;;   (defun find-cutset (nodenum1 nodenum2 dag-array ;supporters-array
;;                                )
;;     (if (quotep nodenum1)
;;         nil
;;       (let* ((expr (aref1 'dag-array dag-array nodenum1)))
;;         (if (variablep expr)
;;             (list nodenum1) ;BBOZO should we check that the var supports nodenum2
;;           (if (fquotep expr)
;;               nil
;;             ;;function call case...
;;             (if ;(member nodenum1 (aref1 'supporters-array supporters-array nodenum2))
;;                 (in-subdag nodenum1 nodenum2 dag-array)
;;                 (list nodenum1)
;;               (find-cutset-lst (fargs expr) nodenum2 dag-array ;supporters-array
;;                                )))))))

;;   (defun find-cutset-lst (nodenum1s nodenum2 dag-array ;supporters-array
;;                                     )
;;     (if (atom nodenum1s)
;;         nil
;;       (union$ (find-cutset (car nodenum1s) nodenum2 dag-array ;supporters-array
;;                               )
;;                  (find-cutset-lst (cdr nodenum1s) nodenum2 dag-array ;supporters-array
;;                                   ))))))

;; (defun find-cutset-wrapper (nodenum1 nodenum2 dag-array)
;;   (find-cutset (max nodenum1 nodenum2) (min nodenum1 nodenum2) dag-array))

;; ;tests that nothing in cutset supports nodenum
;; (defun not-supported-by-any (nodenum cutset dag-array)
;;   (if (atom cutset)
;;       t
;;     ;;     (if (< nodenum (minelem cutset)) ;could wait to just do this test in in-subdag?
;;     ;;         t
;;     (and (not (in-subdag (car cutset) nodenum dag-array))
;;          (not-supported-by-any nodenum (cdr cutset) dag-array))))



;; (skip -proofs
;;  (mutual-recursion
;; ;simlar to other functions that already exist?
;; ;item is a nodenum or a quoted constant
;;   (defun constant-nodep (item dag-array)
;;     (if (quotep item)
;;         t
;;       ;;else, it's a nodenum
;;       (let ((expr (aref1 'dag-array dag-array item)))
;;         (if (variablep expr)
;;             nil
;;           (if (fquotep expr)
;;               t
;;             ;;function call
;;             (constant-nodep-lst (fargs expr) dag-array))))))

;;   (defun constant-nodep-lst (items dag-array)
;;     (if (atom items)
;;         t
;;       (and (constant-nodep (car items) dag-array)
;;            (constant-nodep-lst (cdr items) dag-array))))))


;; ;BBOZO here and elsewhere check to ensure that the variable names created are fresh!
;; ;this version is "trimmed" in the following set.  as soon as we encounter a
;; ;node that is not supported by anything in the cutset, we put in a variable
;; (skip -proofs
;;  (mutual-recursion
;;   ;;nodenum might be a quoted constant too?
;;   (defun build-term-for-node-with-cutset-trimmed (nodenum cutset dag-array vars-acc)
;;     (if (quotep nodenum)
;;         (mv nodenum vars-acc)
;;       ;;otherwise it's a real nodenum
;;       (if (member nodenum cutset)
;;           (let ((varname (pack$ "VAR" (nat-to-string nodenum))))
;;             (mv varname (add-to-set-equal nodenum vars-acc)))
;;         ;;bbozo cache the created symbols for the variable names to speed things up?

;;         ;; If we encounter a node that is not supported by any node in the
;;         ;; cutset it must be irrelevant to the proof?  Exception: if the node
;;         ;; is just a constant (more generally, a ground term?) we should not
;;         ;; replace it with a variable.
;;         (if (and (not-supported-by-any nodenum cutset dag-array)
;;                  (not (constant-nodep nodenum dag-array)))
;;             (let ((varname (pack$ "VAR" (nat-to-string nodenum))))
;;               (mv varname (add-to-set-equal nodenum vars-acc)))

;;           (let ((expr (aref1 'dag-array dag-array nodenum)))
;;             (if (variablep expr)
;;                 (mv expr (add-to-set-equal expr vars-acc))
;;               (if (fquotep expr)
;;                   (mv expr vars-acc)
;;                 (let* ((fn (car expr))
;;                        (args (fargs expr)))
;;                   (mv-let (args vars-acc)
;;                           (build-term-for-node-with-cutset-trimmed-lst args cutset dag-array vars-acc)
;;                           (mv (cons fn args) vars-acc))))))))))

;;   (defun build-term-for-node-with-cutset-trimmed-lst (items cutset dag-array vars-acc)
;;     (if (atom items)
;;         (mv nil vars-acc)
;;       (mv-let (car-term vars-acc)
;;               (build-term-for-node-with-cutset-trimmed (car items) cutset dag-array vars-acc)
;;               (mv-let (cdr-terms vars-acc)
;;                       (build-term-for-node-with-cutset-trimmed-lst (cdr items) cutset dag-array vars-acc)
;;                       (mv (cons car-term cdr-terms)
;;                           vars-acc)))))))


;; (skip -proofs
;;  (mutual-recursion

;; ;returns (mv term vars-mentioned) where vars-mentioned is a list of symbols (for the variables of the dag, or integers, for nodenums)
;;   ;;nodenum might be a quoted constant too?
;;   (defun build-term-for-node-with-cutset (nodenum cutset dag-array vars-acc)
;;     (if (quotep nodenum)
;;         (mv nodenum vars-acc)
;;       ;;otherwise it's a real nodenum
;;       (if (member nodenum cutset)
;;           ;;bbozo cache these to speed things up?
;;           (let ((varname (pack$ "VAR" (nat-to-string nodenum))))
;;             (mv varname (add-to-set-equal nodenum vars-acc)))
;;         (let ((expr (aref1 'dag-array dag-array nodenum)))
;;           (if (variablep expr)
;;               (mv expr (add-to-set-equal expr vars-acc))
;;             (if (fquotep expr)
;;                 (mv expr vars-acc)
;;               (let* ((fn (car expr))
;;                      (args (fargs expr)))
;;                 (mv-let (args vars-acc)
;;                         (build-term-for-node-with-cutset-lst args cutset dag-array vars-acc)
;;                         (mv (cons fn args) vars-acc)))))))))

;;   (defun build-term-for-node-with-cutset-lst (items cutset dag-array vars-acc)
;;     (if (atom items)
;;         (mv nil vars-acc)
;;       (mv-let (car-term vars-acc)
;;               (build-term-for-node-with-cutset (car items) cutset dag-array vars-acc)
;;               (mv-let (cdr-terms vars-acc)
;;                       (build-term-for-node-with-cutset-lst (cdr items) cutset dag-array vars-acc)
;;                       (mv (cons car-term cdr-terms) vars-acc)))))))

;; ;returns a list of strings
;; (defun make-var-name-aux2 (nodenumset)
;;   (if (endp nodenumset)
;;       nil
;;     (cons "_" ;STP doesn't like dashes
;;           (cons (nat-to-string (car nodenumset))
;;                 (make-var-name-aux2 (cdr nodenumset))))))

;; (skip -proofs (verify-guards make-var-name-aux2))

;; ;get this working again
;; ;move this??
;; ;; returns (mv validp timedoutp state) where validp indicates whether the goal is "Valid."
;; (defun check-with-stp-fn (term var-size-alist max-conflicts state)
;;   (declare (xargs :mode :program
;;                   :stobjs state
;;                   :guard (pseudo-termp term)))
;;   (mv-let (nodenum-or-quotep dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;           (make-term-into-dag-array term 'dag-array 'dag-parent-array)
;;           (declare (ignore dag-len dag-parent-array dag-constant-alist dag-variable-alist))
;;           (if (quotep nodenum-or-quotep)
;;               (if (unquote nodenum-or-quotep)
;;                   (prog2$ (cw "The DAG is the non-nil constant ~x0." nodenum-or-quotep)
;;                           (mv t nil state))
;;                 (prog2$ (cw "The DAG is the constant NIL." nodenum-or-quotep)
;;                         (mv nil nil state)))
;;             (prove-array-node-with-stp dag-array nodenum-or-quotep var-size-alist max-conflicts state))))

;; ;get this working again
;; (defmacro check-with-stp (term var-size-alist)
;;   `(time$ (check-with-stp-fn ,term ,var-size-alist
;;                              nil ;max-conflicts
;;                              state)))

;; ;drop this favor of the other?
;; ;returns (mv result state) where result is :error, :failed, or (list new-runes new-fns)
;; ;gen to work on any function whose body is an ite nest with exactly one recursive call in it?
;; (defun peel-off-base-case (fn formals exit-test-expr base-case-expr update-expr-list state)
;;   (declare (xargs :mode :program))
;;   (let* ((new-fn (pack$ fn '-peeled-off))
;;          (formals-mentioned-in-base-case-expr (get-vars-from-term base-case-expr))
;; ;check for vars that aren't formals or for no mentioned vars?
;; ;this just puts them in order:
;;          (formals-in-base-case (intersection-eq formals formals-mentioned-in-base-case-expr))
;;          (just-one-formalp (eql 1 (len formals-in-base-case)))

;;          ;ffixme use the measure of the original function?
;;          (defun `(skip -proofs
;;                   (defun ,new-fn ,formals
;;                    (if ,exit-test-expr
;;                        ,(if just-one-formalp
;;                             ;;just return the formal:
;;                             (first formals-in-base-case)
;;                           ;;make a list of the formals
;;                           (make-cons-nest formals-in-base-case))
;;                      (,new-fn ,@update-expr-list)))))
;;          (new-fn-call (cons new-fn formals)) ;the new function has the same formals
;;          (formal-replacement-alist
;;           (if just-one-formalp
;;               ;;the formal gets replaced by the whole fn-call:
;;               (acons (first formals) new-fn-call nil)
;;             ;;each formal gets replace by the correct call to nth of the fn-call:
;;             (pairlis$ formals-in-base-case
;;                         (make-nth-terms (len formals-in-base-case) new-fn-call))))
;;          (new-term (replace-in-term2 base-case-expr formal-replacement-alist))
;;          (theorem-name (pack$ fn '-becomes- new-fn)))
;;     (mv-let (erp result state)
;;             (submit-events-brief
;;              `(,defun ;the new function
;;                 ;;the replacement rule:
;;                 (defthm ,theorem-name
;;                   (equal (,fn ,@formals)
;;                          ,new-term)
;;                   :hints (("Goal" :in-theory (union-theories (theory 'minimal-theory)
;;                                                              '(,fn
;;                                                                ,new-fn))

;;                            :induct t))))
;;              state)
;;             (declare (ignore result)) ;;fixme?
;;             (if erp
;;                 (mv :error state)
;;               (mv (list `((:rewrite ,theorem-name))
;;                         (list new-fn))
;;                   state)))))

;;returns (mv erp runes state)
;combine with the -concs version?
;rename
; start by trying to prove them all together - replaced this while function
; what if some fail? - replaced this while function
;; (defun prove-update-fn-preserves-preds (preds
;;                                         hyps
;;                                         name-to-append
;;                                         rune-num prover-rules extra-stuff
;;                                         interpreted-function-alist runes-acc
;;                                         test-cases-for-formals ;each test case is an alist?
;;                                         state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (if (endp preds)
;;       (mv nil runes-acc state)
;;     (let* ((pred (car preds))
;;            (rule-name (pack$ name-to-append '-preserves-pred- (nat-to-string rune-num))))
;;       (mv-let (erp state)
;;               (my-defthm-fn2 rule-name
;;                              hyps
;;                              (list pred)
;;                              `(("Goal"
;;                                 :in-theory (theory 'minimal-theory)
;;                                 :do-not '(generalize eliminate-destructors))
;;                                (if STABLE-UNDER-SIMPLIFICATIONP
;;                                    '(:clause-processor
;;                                      ;would be nice if this call could communicate back some information (e.g., the lemmas it found about recursive functions...)
;;                                      (axe-prover
;;                                       clause
;;                                       ',(s :goal-name (symbol-name rule-name)
;;                                            (s :print t
;;                                               (axe-prover-hints
;;                                                nil
;;                                                prover-rules interpreted-function-alist
;;                                                (firstn 1006 test-cases-for-formals) ;if we include all of these there may be very many (many calls for each trace)
;;                                                (empty-analyzed-function-table) ;fffixme
;;                                                )))
;;                                       state)
;;                                      :do-not '(generalize eliminate-destructors))
;;                                  nil))
;;                              t ; elide hints
;;                              nil
;;                              nil ;don't print - pass in an option?
;;                              state)
;;               (if erp
;;                   (mv t nil state)
;;                 (prove-update-fn-preserves-preds (cdr preds)
;;                                                  hyps
;;                                                  name-to-append
;;                                                  (+ 1 rune-num)
;;                                                  prover-rules extra-stuff interpreted-function-alist
;;                                                  (cons `(:rewrite ,rule-name)
;;                                                        runes-acc)
;;                                                  test-cases-for-formals
;;                                                  state))))))

;; ;FIXME separate the compose and the simplify?
;; ;FIXME what if subdag-for-var is a quotep? if we are being consistent in our inlining of constants, we'll have to inline everywhere the variable's nodenum appears
;; ;returns (mv result state)
;; (defun compose-dags-and-simplify (main-dag var-to-replace subdag-for-var rules assumptions state)
;;   (declare (xargs ;:guard (pseudo-termp term)
;;             :verify-guards nil
;;             :mode :program
;;             :stobjs state))
;;   (mv-let (composed-dag state)
;;           (compose-dags main-dag var-to-replace subdag-for-var t state)
;;           ;;fixme - just pass in the rules to compose-dags.. - or redo it so it doesn't have to do a full rewrite...
;;           (quick-simplify-dag composed-dag
;;                               rules
;;                               :assumptions assumptions
;;                               :slack-amount (* 10 (+ (len main-dag) (len subdag-for-var))))))

;; (defun set-equal (x y)
;;   (and (subsetp-eq x y)
;;        (subsetp-eq y x)))


;; ;BOZO there are like 3 versions of this now...
;; ;BOZO adapt these to use arrays
;; (defun resolve-refs-to-constants-in-args-full (args dag)
;;   (if (endp args)
;;       nil
;;     (let ((arg (car args)))
;;       (if (atom arg)
;;           (let ((expr (lookup arg dag)))
;;             (if (and (consp expr)
;;                      (fquotep expr)
;; ;                     (not (consp (unquote expr))) ;don't do it to constants that are bigger than atoms
;;                      )
;;                 (cons expr (resolve-refs-to-constants-in-args-full (cdr args) dag))
;;               (cons arg (resolve-refs-to-constants-in-args-full (cdr args) dag))))
;;         (cons arg (resolve-refs-to-constants-in-args-full (cdr args) dag))))))

;; (defun resolve-refs-to-constants-full (dag)
;;   (if (endp dag)
;;       nil
;;     (let* ((entry (car dag))
;;            (nodenum (car entry))
;;            (expr (cdr entry)))
;;       (if (or (not (consp expr))
;;               (fquotep expr))
;;           (cons entry (resolve-refs-to-constants-full (cdr dag)))
;;         (let* ((fn (car expr))
;;                (args (fargs expr))
;;                (new-args (resolve-refs-to-constants-in-args-full args dag))
;;                )
;;           (cons (cons nodenum (cons fn new-args)) (resolve-refs-to-constants-full (cdr dag))))))))

;; ;returns (mv erp runes state)
;; ;puts in free vars so things will match
;; (defun make-strengthened-rules (strengthenable-pred-infos
;;                                 base-theorem-name
;;                                 fn-call
;;                                 hyps
;;                                 unchanged-components
;;                                 simplified-exit-test-of-fn-call-theorem-name
;;                                 fn-preserves-preds-pushed-back-theorem-name
;;                                 prover-rules runes-acc state)
;;   (declare (xargs :mode :program))
;;   (if (endp strengthenable-pred-infos)
;;       (mv nil runes-acc state)
;;     (let* ((info (car strengthenable-pred-infos))
;;            (strengthened-pred-of-fn-call (car info)) ;doesn't have any vars put in yet - should be an equality!
;;            (supporting-pred-numbers (cdr info))) ;currently only used for the name!
;; ;skip this check?
;;       (if (not (find-term fn-call strengthened-pred-of-fn-call))
;;           (prog2$ (cw "!! make-strengthened-rules is skipping pred ~x0.~%" strengthened-pred-of-fn-call)
;;                   ;;skip this pred (i.e., this conclusion) if it doesn't mention the function call at all (because all the RVs mentioned in it are unchanged and so have been replaced by params)
;;                   (make-strengthened-rules (cdr strengthenable-pred-infos)
;;                                            base-theorem-name fn-call
;;                                            hyps unchanged-components
;;                                            simplified-exit-test-of-fn-call-theorem-name
;;                                            fn-preserves-preds-pushed-back-theorem-name
;;                                            prover-rules runes-acc state))
;;         (let* ((pred-lhs (first (fargs strengthened-pred-of-fn-call)))
;;                (pred-rhs (second (fargs strengthened-pred-of-fn-call)))
;; ;will there ever be any of these?
;;                (unchanged-components-mentioned (remove-duplicates-equal (find-terms unchanged-components pred-lhs)))
;;                (new-vars (make-var-names-aux 'param-var- 1 (len unchanged-components-mentioned)))
;;                (unchanged-component-var-alist (pairlis$ unchanged-components-mentioned new-vars))
;;                (pred-lhs-with-vars (replace-in-term2 pred-lhs unchanged-component-var-alist))
;;                (var-equalities (make-equalities new-vars unchanged-components-mentioned))
;;                (strengthened-pred-of-fn-call-with-vars `(equal ,pred-lhs-with-vars ,pred-rhs))
;;                ;;(supporting-theorem-names (make-supporting-theorem-names base-theorem-name supporting-pred-numbers))
;;                (theorem-name (pack$ base-theorem-name
;;                                    '-strengthened
;;                                    (precede-with-dashes supporting-pred-numbers))))
;;           (mv-let (erp state)
;;                   ;;prove that the (simplified) exit test, together with the original preds, imply the strengthened pred
;;                   (my-defthm
;;                    theorem-name
;;                    (append var-equalities hyps)
;;                    (list strengthened-pred-of-fn-call-with-vars)
;;                    :hints
;;                    ;;fixme think about what to use here: - use the dag prover?!
;;                    `(("Goal" :use (;;,non-strengthened-theorem-name
;;                                    ;; we may need these facts about fn-call
;; ;the generated theorems remove this:
;;                                    (:instance ,fn-preserves-preds-pushed-back-theorem-name) ;ffixme should we use just the preds in supporting-pred-numbers?
;;                                    (:instance ,simplified-exit-test-of-fn-call-theorem-name
;;                                               ;;,@(make-bindings-for-use-hint vars-that-dont-appear
;;                                               ;;                                         unchanged-component-var-alist)
;;                                               ))
;;                       :do-not '(generalize eliminate-destructors)
;; ;so that the rules for this function don't remove the conclusions <-old comment?
;;                       :in-theory (theory 'minimal-theory) ;(current-theory ',fn-preserves-preds-pushed-back-theorem-name)
;;                       ;;                       :in-theory (union-theories (theory 'minimal-theory)
;;                       ;;                                                  ;;fixme - what other rules might we need?
;;                       ;;                                                  '(BVLT-WHEN-BVLT-MUST-BE ;fixme add polarity to this rule?
;;                       ;;                                                    BVCHOP-IDENTITY))
;;                       )
;;                      (and stable-under-simplificationp
;;                           '(:clause-processor
;;                             (axe-prover
;;                              clause
;;                              ',(axe-prover-hints ;axe-prover-hints should be a macro?
;;                                 nil              ;runes
;;                                 prover-rules
;;                                 nil ;interpreted-function-alist
;;                                 nil ;test cases
;;                                                    (empty-analyzed-function-table) ;fffixme
;;                                 )
;;                              state)
;;                             :do-not '(generalize eliminate-destructors)))))
;;                   (if erp
;;                       (mv t nil state)
;;                     (make-strengthened-rules (cdr strengthenable-pred-infos)
;;                                              base-theorem-name fn-call
;;                                              hyps
;;                                              unchanged-components
;;                                              simplified-exit-test-of-fn-call-theorem-name
;;                                              fn-preserves-preds-pushed-back-theorem-name
;;                                              prover-rules
;;                                              (cons `(:rewrite ,theorem-name) runes-acc) state))))))))


;; ;;does this duplicate stuff in simplify-dag-lst?
;; ;returns a list of terms, so this can blow up!
;; (defun get-context-assumptions-for-nodenum (nodenum dag-array dag-len)
;; ;for each nodenum, get its context (could we do less, since all we care about is the pred list for nodenum?):
;;   (let* ((known-predicate-array ;pairs nodenums with their contexts (predicate lists)
;;           (make-known-predicate-array-from-array dag-array dag-len))
;;          (known-predicates-for-nodenum (aref1 'known-predicate-array known-predicate-array nodenum))
;;          (nodenums-in-known-predicates-for-nodenum (strip-any-nots known-predicates-for-nodenum))
;; ;just get the ones we need instead of making the alist?
;;          (predicate-nodenum-term-alist (pair-nodenums-with-terms-from-array
;;                                         nodenums-in-known-predicates-for-nodenum ;;nodenums-mentioned-in-contexts
;;                                         dag-array)) ;can blow up!
;;          (extra-assumptions (get-extra-assumptions known-predicates-for-nodenum predicate-nodenum-term-alist))
;;          (dummy (cw "Using ~x0 extra assumption(s) for node ~x1.~%" (len extra-assumptions) nodenum)))
;;     (declare (ignore dummy))
;;     extra-assumptions))

;; ;returns (mv term free-vars-flg) where free-vars-flg indicates whether any
;; ;variable remain unbound (if so, then any such vars have been wrapped in calls
;; ;to :free - this is to distinguish them from vars introduced by matching free vars with assumptions
;; (skip -proofs
;;  (mutual-recursion
;;   (defun instantiate-hyp (form alist free-vars-flg interpreted-function-alist)
;;     (declare (xargs :verify-guards nil
;;                     :guard (and (symbol-alistp alist)
;;                                 (pseudo-termp form))))
;;     (cond ((variablep form)
;;            (let ((a (assoc-eq form alist)))
;;              (cond (a (mv (cdr a) free-vars-flg)) ;the var has a binding in the alist and so is not free
;;                    (t (mv `(:free ,form) t))      ;the var is free
;;                    )))
;;           ((fquotep form) (mv form free-vars-flg))
;;           (t (let ((fn (ffn-symb form)))
;;                ;;used to handle IFs specially, but how often will a hyp be an IF with a resolvable test?
;;                ;;a regular function call:
;;                (mv-let (ground-termp args free-vars-flg)
;;                        (instantiate-hyp-lst (fargs form) alist free-vars-flg interpreted-function-alist)
;;                        (if (and ground-termp
;;                                 (or (member-eq fn *axe-evaluator-functions*) ;switched Wed Jan 13 07:55:10 2010
;;                                     (assoc-eq fn interpreted-function-alist) ;ffffffixme
;;                                     )
;;                                 (not (eq 'th fn))) ;;ffffixme
;;                            (mv (enquote (apply-axe-evaluator ;2
;;                                          fn
;;                                          (unquote-list args)
;;                                          interpreted-function-alist 0))
;;                                free-vars-flg)
;;                          ;;                              (let ((possible-val (eval-fn-if-possible fn (unquote-list args))))
;;                          ;;                                (if possible-val ;possible-val is quoted (or is nil if we can't eval the fn)
;;                          ;;                                    (mv possible-val free-vars-flg) ;should be nil
;;                          ;;                                  (mv (cons fn args) free-vars-flg)))
;;                          (mv (cons fn args) free-vars-flg)))))))

;;   ;;returns (mv ground-termp args extra-vars)
;;   (defun instantiate-hyp-lst (l alist free-vars-flg interpreted-function-alist)
;;     (declare (xargs :verify-guards nil
;;                     :guard (and (symbol-alistp alist)
;;                                 (pseudo-term-listp l))))
;;     (if (null l) ;would endp be faster?
;;         (mv t nil free-vars-flg)
;;       (mv-let (new-car free-vars-flg)
;;               (instantiate-hyp (car l) alist free-vars-flg interpreted-function-alist)
;;               (mv-let (cdr-ground-termp new-cdr free-vars-flg)
;;                       (instantiate-hyp-lst (cdr l) alist free-vars-flg interpreted-function-alist)
;;                       (mv (and cdr-ground-termp (quotep new-car))
;;                           (cons new-car new-cdr)
;;                           free-vars-flg)))))))

;; (skip -proofs (verify-guards instantiate-hyp))

;; ;the pattern is a tree (e.g., a partially instantiated hyp) with leaves that are quoteps, nodenums into dag-array, vars (really?) and vars wrapped in :free
;; ;the target is a tree (e.g., an assumption) with quoteps and variables at the leaves (no nodenums)
;; ;we seek matches to bind the vars inside :free.  everything else must match exactly.
;; ;returns (mv success-flg alist) ;fixme could return just one value (use :fail to indicate failure)?
;; ;fixme - pass in a partial alist and extend it?
;; ;the arity of all functions should be right, so in the list case the lists should have the same length
;; ;fixme thread the alist through these functions!
;; ;fixme before doing any consing, make sure the assumption is the right shape..
;; (defund unify-pattern-sexp (pattern-or-lst target-or-lst lst-flg dag-array)
;; ;  (declare (xargs :verify-guards nil))
;;   (if lst-flg
;;       (if (endp pattern-or-lst)
;;           (mv t nil)
;;         (mv-let (flg alist1)
;;                 (unify-pattern-sexp (first pattern-or-lst) (first target-or-lst) nil dag-array)
;;                 (if flg
;;                     (mv-let (flg2 alist2)
;;                             (unify-pattern-sexp (rest pattern-or-lst) (rest target-or-lst) t dag-array)
;;                             (if (and flg2 (consistent-alists alist1 alist2)) ;fixme better to thread an alist through these functions
;;                                 (mv t (union-equal alist1 alist2) ;fixme just do append?
;;                                     )
;;                               (mv nil nil)))
;;                   (mv nil nil))))
;;     ;;non-list case:
;;     (if (consp pattern-or-lst)
;;         (if (fquotep pattern-or-lst)
;;             (mv (equal target-or-lst pattern-or-lst)
;;                 nil)
;;           (if (eq :free (ffn-symb pattern-or-lst))
;;               (let ((var (second pattern-or-lst)))
;;                 ;; it's a free variable, so bind it to whatever is in the target
;;                 (mv t (acons-fast var target-or-lst nil)))
;;             ;;pattern is a true function call
;;             (if (not (consp target-or-lst)) ;target must also be a function call
;;                 (mv nil nil)
;;               (if (equal (ffn-symb target-or-lst) (ffn-symb pattern-or-lst)) ; i guess this allows lambdas?
;;                   (unify-pattern-sexp (fargs pattern-or-lst) (fargs target-or-lst) t dag-array)
;;                 ;;fails to match:
;;                 (mv nil nil)))))
;;       (if (symbolp pattern-or-lst)
;;           ;;this is a naked (not :free) variable, so it must match exactly.  this is probably rare
;;           (mv (equal pattern-or-lst target-or-lst)
;;               nil)
;;         ;; pattern must be a nodenum
;;         ;; the expression at that nodenum in the dag must match the current target exactly:
;;         (mv (match-term-with-dag nil target-or-lst pattern-or-lst dag-array)
;;             nil)))))

;; (skip -proofs (verify-guards unify-pattern-sexp))

;; ;keeps trying members of target-lst until it finds a match
;; ;returns (mv success-flg alist)
;; ;vars in PATTERN that to be matched are in calls to :free
;; ;other vars must match exactly
;; ;fixme - pass in a partial alist?
;; ;rename - really tests if a pattern matches any target?
;; (defund unify-pattern-sexp-lst (pattern target-lst dag-array)
;;   (if (endp target-lst)
;;       (mv nil nil)
;;     (let ((target (car target-lst)))
;;       (mv-let (flg alist)
;;               (unify-pattern-sexp pattern target nil dag-array)
;;               (if flg
;;                   (mv t alist)
;;                 (unify-pattern-sexp-lst pattern (cdr target-lst) dag-array))))))

;; (skip -proofs (verify-guards unify-pattern-sexp-lst))

;; ;use these more?
;; ;these should be macros?
;; (defun if-test (fn args)
;;   (declare (xargs :guard (true-listp args)))
;;   (case fn
;;         ((if myif boolif) (first args))
;;         (bvif (second args))
;;         (otherwise nil)))

;; (defun if-then-branch (fn args)
;;   (declare (xargs :guard (true-listp args)))
;;   (case fn
;;         ((if myif boolif) (second args))
;;         (bvif (third args))
;;         (otherwise nil)))

;; (defun if-else-branch (fn args)
;;   (declare (xargs :guard (true-listp args)))
;;   (case fn
;;         ((if myif boolif) (third args))
;;         (bvif (fourth args))
;;         (otherwise nil)))





;; (defun all-consp-or-nil (items)
;;   (if (endp items)
;;       t
;;     (let ((item (car items)))
;;       (and (or (consp item)
;;                (equal nil item))
;;            (all-consp-or-nil (cdr items))))))

;; ;bozo see all-equal
;; (defun all-equal-item (item items)
;;   (declare (xargs :guard t))
;;   (if (not (consp items))
;;       t
;;     (and (equal item (car items))
;;          (all-equal-item item (cdr items)))))

;; ;see all-same
;; (defun all-the-same-constant (sig)
;;   (declare (xargs :guard t))
;;   (if (not (consp sig))
;;       t
;;     (let ((item (car sig)))
;;       (all-equal-item item (cdr sig)))))


;BOZO i suppose we could pick a representative for each set and store the wait-set only there???...

;; ;fixme somehow a var snuck into nodenums!
;; (defun sum-of-node-sizes (nodenums size-array)
;;   (if (endp nodenums)
;;       0
;;     (+ (aref1 'size-array size-array (car nodenums))
;;        (sum-of-node-sizes (cdr nodenums) size-array))))

;; (skip -proofs (verify-guards sum-of-node-sizes))

;; ;this one filters out symbols, quoteps, etc. - no need to cons up the filtered list, as we were doing
;; (defun sum-of-node-sizes2 (items size-array)
;;   (if (endp items)
;;       0
;;     (let ((item (car items)))
;;       (if (integerp item)
;;           (+ (aref1 'size-array size-array item)
;;              (sum-of-node-sizes2 (cdr items) size-array))
;;         (sum-of-node-sizes2 (cdr items) size-array)))))

;; (skip -proofs (verify-guards sum-of-node-sizes2))

;; ;fixme, i think the dag can have arraynames in arg positions! is this still true?
;; (defun add-node-sizes-to-size-array (n len dag-array-name dag-array size-array)
;;   (declare (xargs :measure (+ 1 (nfix (- len n)))
;;                   ))
;;   (if (or (not (natp n))
;;           (not (natp len))
;;           (>= n len))
;;       size-array
;;     (let* ((expr (aref1 dag-array-name dag-array n)))
;;       (if (or (variablep expr)
;;               (fquotep expr))
;;           (add-node-sizes-to-size-array (+ 1 n)
;;                                         len
;;                                         dag-array-name dag-array
;;                                         (aset1-safe 'size-array size-array n 1))
;;         (let ((args (fargs expr)))
;;           (add-node-sizes-to-size-array (+ 1 n)
;;                                         len
;;                                         dag-array-name dag-array
;;                                         (aset1-safe 'size-array
;;                                                size-array
;;                                                n
;;                                                ;;fixme can args contain variables?
;;                                                (+ 1 (sum-of-node-sizes2 args size-array))
;;                                                )))))))

;; (skip -proofs (verify-guards add-node-sizes-to-size-array))

;; ;should we make sure one node in the set is ready?  will there always be such a node?
;; (defun get-nodenum-for-minimum-replacement-set (n len current-best-size current-best-nodenum sweep-array size-array)
;;   (declare (xargs :measure (+ 1 (nfix (- len n)))
;;                   ))
;;   (if (or (not (natp n))
;;           (not (natp len))
;;           (>= n len))
;;       current-best-nodenum
;;     (let ((size (aref1 'size-array size-array n)))
;;       (if (and (get-node-tag n *probable-constant-that-needs-to-be-replaced* sweep-array)
;;                (< size
;;                   current-best-size))
;;           (get-nodenum-for-minimum-replacement-set (+ 1 n)
;;                                                    len
;;                                                    size
;;                                                    n
;;                                                    sweep-array
;;                                                    size-array)
;;         (let* ((equal-set (get-node-tag n *probably-equal-node-that-needs-to-be-replaced* sweep-array))
;;                (sum-of-sizes (sum-of-node-sizes equal-set size-array)) ;use sum-of-node-sizes2?
;;                )
;;           (if (and equal-set
;;                    (< sum-of-sizes
;;                       current-best-size))
;;               (get-nodenum-for-minimum-replacement-set (+ 1 n)
;;                                                        len
;;                                                        sum-of-sizes
;;                                                        n
;;                                                        sweep-array
;;                                                        size-array)
;;             (get-nodenum-for-minimum-replacement-set (+ 1 n)
;;                                                      len
;;                                                      current-best-size
;;                                                      current-best-nodenum
;;                                                      sweep-array
;;                                                      size-array)))))))

;; (skip -proofs (verify-guards get-nodenum-for-minimum-replacement-set))

;how can this happen (when there are still nodes to replace)?
;the only case may be that a node in a to-be-replaced probably-equal set depends on another node in the same set - or there are 2 sets, each depending on the other
;not quite sure what to do here, so i'm trying this:
;FIXME think this through! look for a node set with at least one ready node and where the other node would be ready except it depends on the first node (node sets are just pairs now, right?)
;; (defun find-nodenum-to-replace-when-no-safe-sets (len sweep-array dag-array-name dag-array)
;;   (let* ((size-array (new-array1 'size-array len))
;;          (size-array (add-node-sizes-to-size-array 0 len dag-array-name dag-array size-array))
;;          ;;bozo on the big number below
;;          (nodenum (get-nodenum-for-minimum-replacement-set 0 len 100000000000000000000000000 'error-didnt-find-any-nodenums-to-replace sweep-array size-array)))
;;     (if nodenum  ;FIXME nodenum may always be an integer...
;;         nodenum
;;       (hard-error 'find-nodenum-to-replace-when-no-safe-sets "Didn't find any node to replace" nil))))

;; (skip -proofs (verify-guards find-nodenum-to-replace-when-no-safe-sets))

;; (defun all-ready (nodenums sweep-array)
;;   (if (atom nodenums)
;;       t
;;     (if (get-node-tag (car nodenums) *ready* sweep-array)
;;         (all-ready (cdr nodenums) sweep-array)
;;       nil)))

;; (skip -proofs (verify-guards all-ready))


;; (defun all-nodes-are-ready (items sweep-array)
;;   (if (atom items)
;;       t
;;     (let ((item (car items)))
;;       (if (not (integerp item)) ;this skips quoteps and array names
;;           (all-nodes-are-ready (cdr items) sweep-array)
;;         (if (get-node-tag item *ready* sweep-array)
;;             (all-nodes-are-ready (cdr items) sweep-array)
;;           nil)))))

;; (defun no-nodes-are-to-be-replaced (items sweep-array)
;;   (if (atom items)
;;       t
;;     (let ((item (car items)))
;;       (if (not (integerp item)) ;this skips quoteps and array names
;;           (no-nodes-are-to-be-replaced (cdr items) sweep-array)
;;         (if (or (get-node-tag item *probable-constant-that-needs-to-be-replaced* sweep-array)
;;                 (get-node-tag item *probably-equal-node-that-needs-to-be-replaced* sweep-array))
;;             nil
;;           (no-nodes-are-to-be-replaced (cdr items) sweep-array))))))

;a node is "ready" (reflected in the sweep-array) if it does not depend on any unhandled probably-equal or probably-constant nodes.
;ffixme what if it depends on a node that it is probably equal to? we'll have to check for that separately

;; ; initially, no nodes are ready because there are no ready tags set
;; ; constants and variables are ready
;; ; a function call node is ready if all of its children are ready and not to-be-replaced
;; (defun compute-initial-readiness-info (n len dag-array-name dag-array sweep-array)
;;   (declare (xargs :measure (+ 1 (nfix (- len n)))))
;;   (if (or (not (natp n))
;;           (not (natp len))
;;           (>= n len))
;;       sweep-array
;;     (let* ((expr (aref1 dag-array-name dag-array n))
;;            (node-is-ready (or (variablep expr)
;;                               (fquotep expr)
;;                               ;;function call:
;;                               (and (all-nodes-are-ready (fargs expr) sweep-array)
;;                                    (no-nodes-are-to-be-replaced (fargs expr) sweep-array)))))
;;       (compute-initial-readiness-info (+ 1 n)
;;                                       len dag-array-name
;;                                       dag-array
;;                                       (if node-is-ready (set-node-tag n *ready* t sweep-array) sweep-array)))))

;; ;this dag-array already has array-names put in? - where else do such dags get used?
;; (skip -proofs
;; ;we make nodenums and any of their ancestors ready (if possible)
;; ;we do this since, when we handle a node, its ancestors might become ready
;; (defun propagate-readiness-info (nodenums dag-array-name dag-array parent-array sweep-array)
;;   (if (atom nodenums)
;;       sweep-array
;;     (let* ((nodenum (car nodenums))
;;            (ready-tag (get-node-tag nodenum *ready* sweep-array)))
;;       (if ready-tag ;if already ready, skip it
;;           (propagate-readiness-info (cdr nodenums) dag-array-name dag-array parent-array sweep-array)
;;         ;;otherwise, try to make the node ready
;;         (let ((expr (aref1 dag-array-name dag-array nodenum)))
;;           (if (or (variablep expr)
;;                   (fquotep expr))
;;               ;;this shouldn't happen
;;               (hard-error 'propagate-readiness-info "I'm surprised to see this called on a non-function-call-node, but node ~x0 is ~x1." (acons #\0 nodenum (acons #\1 expr nil)))
;;             ;;if the node should be made ready (same logic as above):
;;             (if (and (all-nodes-are-ready (fargs expr) sweep-array)
;;                      (no-nodes-are-to-be-replaced (fargs expr) sweep-array))
;;                 ;;make the node ready and add its parents for processing...
;;                 (propagate-readiness-info (union$ (aref1 'parent-array parent-array nodenum)
;;                                                      (cdr nodenums))
;;                                           dag-array-name dag-array
;;                                           parent-array
;;                                           (set-node-tag nodenum *ready* t sweep-array))
;;               ;;otherwise, skip the node (and don't add its parents for consideration)
;;               (propagate-readiness-info (cdr nodenums)
;;                                          dag-array-name dag-array
;;                                         parent-array
;;                                         sweep-array)))))))))

;; ;set the constant or variable node to ready and try to make its ancestors ready
;; (defun set-ready-and-propagate (nodenum dag-array-name dag-array parent-array sweep-array)
;;   (propagate-readiness-info
;;    (aref1 'parent-array parent-array nodenum)
;;    dag-array-name dag-array
;;    parent-array
;;    (set-node-tag nodenum *ready* t sweep-array)))

;; ;returns sweep-array
;; (defun make-ancestors-ready-if-appropriate (nodenum dag-array-name dag-array parent-array sweep-array)
;;   (propagate-readiness-info (aref1 'parent-array parent-array nodenum)
;;                              dag-array-name dag-array
;;                             parent-array
;;                             sweep-array))

;; (defun set-ready-lst (nodenums sweep-array)
;;   (if (atom nodenums)
;;       sweep-array
;;     (set-ready-lst (cdr nodenums)
;;                    (set-node-tag (car nodenums) *ready* t sweep-array))))

;; ;can we save consing this up?
;; (defun get-all-parents (nodenums parent-array)
;;   (if (atom nodenums)
;;       nil
;;     (union$ (aref1 'parent-array parent-array (car nodenums))
;;                (get-all-parents (cdr nodenums) parent-array))))

;; (defun set-ready-lst-and-propagate (nodenums dag-array-name dag-array parent-array sweep-array)
;;   (propagate-readiness-info (get-all-parents nodenums parent-array)
;;                             dag-array-name dag-array
;;                             parent-array
;;                             (set-ready-lst nodenums sweep-array)))


;make term into a dag-lst which could be considered an extension of dag-array
;the numbers of the entries in dag-lst start at starting-nodenum
;returns (mv dag-lst new-nodenum-or-quotep num-nodes-used)
;BOZO do we need both new-nodenum and num-nodes-used?
;;
;; (defund make-term-into-dag-lst (lst-flg term starting-nodenum dag-array parent-array dag-lst)
;;   (declare        ; (ignore dag-array) ;bozo
;;    (xargs         ;;  :GUARD (and (true-listp term)
;;     ;; ;                               (ALIST-with-integer-keysp dag)
;;     ;;                                )
;;     ;;                    :guard-hints (("Goal" :in-theory (enable alistp-guard-hack)))
;;     ;;                    :verify-guards nil
;;     ))
;;   (if lst-flg
;;       (if (consp term)
;;           (mv-let (dag-lst new-nodenum num-nodes-used)
;;                   (make-term-into-dag-lst nil (car term) starting-nodenum dag-array parent-array dag-lst)
;;                   (mv-let (dag-lst new-nodenums num-nodes-used2)
;;                           (make-term-into-dag-lst t (cdr term) (+ num-nodes-used starting-nodenum) dag-array parent-array dag-lst)
;;                           (mv dag-lst
;;                               (cons new-nodenum new-nodenums)
;;                               (+ num-nodes-used num-nodes-used2))))
;;         (mv dag-lst nil 0))
;;     ;;term is an element, not a list:
;;     ;;BBBOZO for all these cases we should perhaps check if the expr is already in the dag, but we're skipping it now for speed
;;     (if (integerp term) ;if it's a nodenum (BOZO check if it's the nodenum of a constant?)
;;         (mv dag-lst     ;don't need to add any nodes
;;             term
;;             0)
;;       (if (variablep term) ;yikes, "variablep" would hit on an integer too?
;;           (mv (acons starting-nodenum
;;                      term
;;                      dag-lst)
;;               starting-nodenum
;;               1)
;;         (if (fquotep term)
;;             (mv dag-lst ;(acons starting-nodenum term dag-lst)
;;                 term    ;starting-nodenum
;;                 0)
;;           ;;otherwise, it's a function call
;;           (let* ((fn (ffn-symb term))
;;                  (args (fargs term)))

;;             ;;BBOZO special handling for ifs?  for ground terms?

;;             ;; add the children into the growing dag-lst
;;             (mv-let (dag-lst nodenums-or-quoteps num-nodes-used)
;;                     (make-term-into-dag-lst t args starting-nodenum dag-array parent-array dag-lst)
;;                     (if ;;nil ;BBOZO
;;                         (and (equal 0 num-nodes-used)

;;                              ;BOZO this is because the parent trick needs a node to lookup - use dag-objects instead!
;;                              (not (all-consp args))) ;if we didn't add any nodes for the children, the current node may be already present as well
;;                         (let* ((expr (cons fn nodenums-or-quoteps))
;;                                (possible-match (find-expr-using-parents expr dag-array parent-array)))
;;                           (if possible-match
;;                               (mv dag-lst
;;                                   possible-match
;;                                   0)
;;                             (mv (acons (+ num-nodes-used starting-nodenum)
;;                                        expr
;;                                        dag-lst)
;;                                 (+ num-nodes-used starting-nodenum)
;;                                 (+ 1 num-nodes-used))))

;;                       (mv (acons (+ num-nodes-used starting-nodenum)
;;                                  (cons fn nodenums-or-quoteps) ;use expr from the let?
;;                                  dag-lst)
;;                           (+ num-nodes-used starting-nodenum)
;;                           (+ 1 num-nodes-used))))))))))

;; (defun rename-expr-aux (items renaming)
;;   (if (endp items)
;;       nil
;;     (let* ((item (car items)))
;;       (if (atom item)
;;           (let ((new-name (lookup item renaming)))
;;             (cons (if new-name new-name item) (rename-expr-aux (cdr items) renaming)))
;;         (cons item (rename-expr-aux (cdr items) renaming))))))

;; (defun rename-expr (expr renaming)
;;   (if (or (variablep expr)
;;           (fquotep expr))
;;       expr
;;     (let* ((fn (ffn-symb expr))
;;            (args (fargs expr)))
;;       (cons fn (rename-expr-aux args renaming)))))



;; ;BBOZO don't need to dereference if we are storing all quoteps inline (maybe start with a phase that resolves all the refs to constants?)
;; ;inefficient!  check the quoteps inline flg?
;; ;returns (mv flg constant-vals)
;; ;now allows items to be things other than quoteps or nodenums
;; (defun lookup-args-if-quoteps (items dag-array)
;;   (declare (xargs; :guard (ALIST-WITH-INTEGER-KEYSP DAG)
;;                   :verify-guards nil
;;                   ))
;;   (if (atom items)
;;       (mv t nil)
;;     (let ((item (car items)))
;;       (if (quotep item) ;just check consp?
;;           (mv-let (flg vals)
;;                   (lookup-args-if-quoteps (cdr items) dag-array)
;;                   (if flg
;;                       (mv t (cons (unquote item) vals))
;;                     (mv nil vals)))

;;         ;put this back (but first check for nodenum b/f derefing) if we decide not to inline all constants
;; ;;         (let ((expr (aref1 'dag-array dag-array item)))
;; ;;           (if (and (consp expr)
;; ;;                    (eq 'quote (car expr)))
;; ;;               (mv-let (flg vals)
;; ;;                       (lookup-args-if-quoteps (cdr items) dag-array)
;; ;;                       (mv flg (cons (unquote expr) vals)))
;;                   (mv nil nil)))))
;; ;))

;(skip -proofs (verify-guards lookup-args-if-quoteps))

;(skip -proofs (verify-guards add-to-dag-lst-unless-present-in-dag-array))
;(skip -proofs (verify-guards make-term-into-dag-lst))
;(skip -proofs (verify-guards simplify-dag))

;; ;fixme in general the type of a cut node can come from the parents, hyps/assumptions/other-literals, and the expression for the node itself (except maybe this code never cuts at a bv/bool node)...
;; (skip -proofs
;;  (mutual-recursion
;;   ;;returns (mv can-translate-subdagp new-supporting-nodenums-to-translate cut-nodenum-type-alist), where if can-translate-subdagp is nil, the other return vars are irrelevant
;;   ;;fixme handle arrays better
;;   ;;everything tagged in translation-tag-array is known to be translatable (and already has all appropriate children tagged too)
;;   ;;fffixme handle exprs that always appear in bv/array argument positions but don't have a type in the alist? parent array may help with this?
;;   ;;fffixme can this ever exponential?  ffixme use a worklist algorithm? could first figure out which nodes that support literals are translatable

;;   (defun can-translate-subdag-to-stp (nodenum dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array new-supporting-nodenums-to-translate-acc cut-nodenum-type-alist print)
;;     (if (or (aref1 'translation-tag-array translation-tag-array nodenum) ;it's already tagged in a previous literal
;;             (member nodenum new-supporting-nodenums-to-translate-acc) ;it's already on the list for this literal - fffixme can this check be slow?
;;             (assoc nodenum cut-nodenum-type-alist) ;it's already a cut node for this literal - fffixme can this check be slow?
;;             ;;ffixme also pass in the nodenum-type-alist for other literals?
;;             )
;;         (mv t new-supporting-nodenums-to-translate-acc cut-nodenum-type-alist)
;;       (let* ((expr (aref1 'dag-array dag-array nodenum)))
;;         (if (atom expr) ;it's a var:
;;             (let ((type (type-of-node-if-we-cut nodenum nodenum-type-alist-from-literals dag-array dag-parent-array)))
;;               (mv type
;;                   new-supporting-nodenums-to-translate-acc ;;we don't actually translate the node
;;                   (acons-fast nodenum type cut-nodenum-type-alist)))
;;           (let ((fn (ffn-symb expr))
;;                 (args (fargs expr)))
;;             (if (eq 'quote fn) ;fixme or we could assume constants are always inlined?
;;                 ;;fixme what about a constant array?
;;                 (mv (natp (unquote expr))
;;                     new-supporting-nodenums-to-translate-acc
;;                     cut-nodenum-type-alist)
;;               (if (not (can-translate-expr-to-stp fn args print))
;;                   ;;if we can't translate the expr, we might be able to cut (make it a variable), if we can find a type for it
;;                   (let ((type (type-of-node-if-we-cut nodenum nodenum-type-alist-from-literals dag-array dag-parent-array)))
;;                     (if type
;;                         (mv t new-supporting-nodenums-to-translate-acc (acons-fast nodenum type cut-nodenum-type-alist))
;;                       ;; if we have a bv-array-read with a constant element-width, we can replace it with a variable (even if we can't translate it since the length is not constant):
;;                       (if (and (eq 'bv-array-read (ffn-symb expr))
;;                                (darg-quoted-posp (first args)))
;;                           (mv t new-supporting-nodenums-to-translate-acc (acons-fast nodenum (make-bv-type (unquote (first args))) cut-nodenum-type-alist))
;;                         (mv nil nil nil))))
;;                 ;;make sure we can translate all the children: - do we have to do this? can't we just cut at the children?
;;                 (mv-let (can-translate-childrenp new-supporting-nodenums-to-translate-acc-with-children cut-nodenum-type-alist-with-children)
;;                         (can-translate-subdag-to-stp-lst args dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array
;;                                                          new-supporting-nodenums-to-translate-acc cut-nodenum-type-alist print)
;;                         (if can-translate-childrenp
;;                             (mv t (cons nodenum new-supporting-nodenums-to-translate-acc-with-children) cut-nodenum-type-alist-with-children)
;;                           ;;we can't translate the children, but maybe we can cut at this node: should we be cutting at the children instead?
;;                           ;;this doesn't use the -with-children versions of things:
;;                           (let ((type (type-of-node-if-we-cut nodenum nodenum-type-alist-from-literals dag-array dag-parent-array)))
;;                             ;;if type is nil, the other RVs here are irrelevant:
;;                             (mv type new-supporting-nodenums-to-translate-acc (acons-fast nodenum type cut-nodenum-type-alist))))))))))))

;;   ;;returns (mv can-translate-termsp new-supporting-nodenums-to-translate new-cut-nodenum-type-alist)
;;   ;;if can-translate-termsp is nil, the other return vars are irrelevant
;;   (defun can-translate-subdag-to-stp-lst (items dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array
;;                                                 new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist print)
;;     (if (endp items)
;;         (mv t new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist)
;;       (let ((item (car items)))
;;         (if (quotep item)
;;             (if (or (natp (unquote item)) ;ffixme what about constant arrays?  fixme what about constant booleans?
;;                     (all-natp (unquote item))) ;fixme new.  think this through
;;                 (can-translate-subdag-to-stp-lst (cdr items) dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array
;;                                                  new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist print)
;;               (mv nil nil nil))
;;           ;;it's a nodenum:
;;           (mv-let (can-translate-termp new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist)
;;                   (can-translate-subdag-to-stp item dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array
;;                                                new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist print)
;;                   (if can-translate-termp
;;                       (can-translate-subdag-to-stp-lst (cdr items) dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array
;;                                                        new-supporting-nodenums-to-translate-acc new-cut-nodenum-type-alist print)
;;                     (mv nil nil nil)))))))))

;; ;decides which literals to translate and tags the relevant nodes for translation
;; ;fixme should be able to translate almost any literal (as a boolean variable in the worst case, unless it's not clearly a boolean...)
;; ;returns (mv literal-nodenums-to-translate translation-tag-array cut-nodenum-type-alist)
;; ;extends cut-nodenum-type-alist
;; ;rename
;; (defun tag-nodes-for-literals (literal-nodenums dag-array dag-parent-array
;;                                                 nodenum-type-alist-from-literals ;type info from "type" literals (e.g., unsigned-byte-p)
;;                                                 translation-tag-array
;;                                                 literal-nodenums-to-translate-acc
;;                                                 cut-nodenum-type-alist ;type info for cut nodes
;;                                                 print)
;;   (if (endp literal-nodenums)
;;       (mv literal-nodenums-to-translate-acc translation-tag-array cut-nodenum-type-alist)
;;     (let* ((literal-nodenum (first literal-nodenums)))
;;       (mv-let (translate-literalp new-supporting-nodenums-to-translate new-cut-nodenum-type-alist) ;can we just thread the same alist through for all literals?
;;               (can-translate-subdag-to-stp literal-nodenum dag-array dag-parent-array nodenum-type-alist-from-literals translation-tag-array nil nil print)
;;               (if translate-literalp
;;                   ;;if can we can translate the literal (perhaps with cutting -- fixme can't we always translate something?), then mark everything used in the literal for translation:
;;                   (tag-nodes-for-literals (rest literal-nodenums) dag-array dag-parent-array nodenum-type-alist-from-literals
;;                                           (aset1-list 'translation-tag-array translation-tag-array
;;                                                       new-supporting-nodenums-to-translate
;;                                                       t)
;;                                           (cons literal-nodenum literal-nodenums-to-translate-acc)
;;                                           (union-equal new-cut-nodenum-type-alist cut-nodenum-type-alist) ;ffixme make sure they will always be consistent
;;                                           print
;;                                           )
;;                 (prog2$ (and (eq :verbose print) (cw "Skipping literal ~x0.~%" literal-nodenum))
;;                         (tag-nodes-for-literals (rest literal-nodenums) dag-array dag-parent-array nodenum-type-alist-from-literals
;;                                                 translation-tag-array
;;                                                 literal-nodenums-to-translate-acc
;;                                                 cut-nodenum-type-alist print)))))))

;; ;the result is sorted in decreasing order, and that matters!
;; (defun get-tagged-nodes (nodenum max-nodenum array-name array acc)
;;   (declare (xargs :measure (nfix (+ 1 (- max-nodenum nodenum)))))
;;   (if (or (not (integerp nodenum))
;;           (not (integerp max-nodenum))
;;           (< max-nodenum nodenum))
;;       acc
;;     (get-tagged-nodes (+ 1 nodenum) max-nodenum array-name array
;;                       (if (aref1 array-name array nodenum)
;;                           (cons nodenum acc)
;;                         acc))))


  ;;   ;; Returns (mv better-invars defthm-names state)
  ;; ;fixme the defthm-names are only one-way implication?
  ;; ;handle much more here!
  ;; ;fffixme be careful of two invars both rewriting each other to t... ;;would like the rewriter to report which assumptions it used??
  ;; ;need an ordering on the invars? mimic what i do with the explanation-graph where i didn't want explanation loops but didn't know what order to use beforehand??
  ;; ;ffixme what if some of the invars rewrite to t - drop them?!
  ;;   ;if we do use an ordering, make sure the unchanged-var invars come first
  ;;   ;ffixme does what we do at (cons result all-regular-invars-except-this-one) below prevent loops?
  ;;   ;fixme, might this benefit from multiple passes?
  ;;   (defun improve-invarsold-aux (regular-invars all-regular-invars unchanged-var-invars count fn improved-regular-invars-acc defthm-names-acc state)
  ;;     (declare (xargs :mode :program :stobjs state))
  ;;     (if (endp regular-invars)
  ;;         (mv (reverse improved-regular-invars-acc)
  ;;             (reverse defthm-names-acc)
  ;;             state)
  ;;       (let* ((invar (first regular-invars))
  ;;              (all-regular-invars-except-this-one (remove-equal invar all-regular-invars)))
  ;;         (progn$ (cw "(Improving invar ~x0:~%" count)
  ;;                 (cw "~x0~%" invar)
  ;;                 (mv-let (result defthm-name state)
  ;;                         (simplify-fact invar
  ;;                                        (append unchanged-var-invars all-regular-invars-except-this-one)
  ;;                                        (pack$ fn '-better-invar-theorem-for-invar- count) state)
  ;;                         (progn$ (cw "Improved invar ~x0 (nil means no change):~%" count)
  ;;                                 (cw "~x0~%" result)
  ;;                                 (cw ")~%")
  ;;                                 (if result ;fixme if it's *t*, drop it here?
  ;;                                     (improve-invarsold-aux (cdr regular-invars)
  ;;                                                         (cons result all-regular-invars-except-this-one) ;does this prevent 2 invars from rewriting each other?
  ;;                                                         unchanged-var-invars
  ;;                                                         (+ 1 count) fn
  ;;                                                         (cons result improved-regular-invars-acc)
  ;;                                                         (cons defthm-name defthm-names-acc)
  ;;                                                         state)
  ;;                                   (improve-invarsold-aux (cdr regular-invars) all-regular-invars unchanged-var-invars (+ 1 count) fn
  ;;                                                       (cons invar improved-regular-invars-acc)
  ;;                                                       defthm-names-acc state))))))))

  ;;   ;; Returns (mv improved-regular-invars defthm-names state)
  ;;   ;used the unchanged-var-invars and the regular-invars themselves (!) to improve the regular-invars
  ;;   (defun improve-invarsold (regular-invars unchanged-var-invars fn state)
  ;;     (declare (xargs :mode :program :stobjs state))
  ;;     (prog2$ (cw "(Improving (regular) invars:~%")
  ;;             (mv-let (improved-regular-invars defthm-names state)
  ;;                     (improve-invarsold-aux regular-invars regular-invars unchanged-var-invars 0 fn nil nil state)
  ;;                     (prog2$ (cw "Done improving invars.)~%")
  ;;                             (mv improved-regular-invars defthm-names state)))))

;; ;walk down the dag-array looking for a value of expr.  returns the index if such is found, otherwise nil
;; (defun find-expr-in-dag-array (n expr dag-array)
;;   (declare (xargs :measure (nfix (+ 1 n))))
;;   (prog2$ nil ;(cw "slow lookup of ~x0.~%" expr) ;BBOZO store the nodenums of vars (and 0-ary functions) in an array like dag-parents-array
;;           (if (or (< n 0)
;;                   (not (integerp n)) ;BOZO a waste?
;;                   )
;;               nil
;;             (let* ((current (aref1 'dag-array dag-array n)))
;;               (if (equal current expr)
;;                   n
;;                 (find-expr-in-dag-array (+ -1 n) expr dag-array))))))

;; (skip -proofs (verify-guards find-expr-in-dag-array))

;; ;returns nil if the list isn't shorter.  else returns its length.
;; (defun list-length-if-shorter (lst length-to-beat)
;;   ;BOZO could optimize by walking down the list and stopping if we're longer that the target length...
;;   (let ((len (len lst)))
;;     (if (< len length-to-beat)
;;         len
;;       nil)))


;; ;bozo if we find a list shorter than, say, 5, just use it?
;; (defun find-shortest-parent-lst (current-shortest-lst current-shortest-lst-length items dag-parent-array)
;;   (if (endp items)
;;       current-shortest-lst
;;     (let ((item (car items)))
;;       (if (not (atom item)) ;skip quoteps
;;           (find-shortest-parent-lst current-shortest-lst current-shortest-lst-length (cdr items) dag-parent-array)
;;         ;; it's a nodenum
;;         (let* ((new-lst (aref1 'dag-parent-array dag-parent-array item))
;;                (result (list-length-if-shorter new-lst current-shortest-lst-length)))
;;           (if result
;;               (find-shortest-parent-lst new-lst result (cdr items) dag-parent-array)
;;             (find-shortest-parent-lst current-shortest-lst current-shortest-lst-length (cdr items) dag-parent-array)))))))

;faster than just computing the len first (which might be large)
;; (defun len-less-than (n lst)
;;   (declare (type (integer 0 *) n)
;;            (xargs :guard (true-listp lst)))
;;   (if (zp n)
;;       nil
;;     (if (atom lst)
;;         t
;;       (len-less-than (+ -1 n) (cdr lst)))))


;; ;; Prove claim (a term over nodes in the miter-array)
;; ;; This rewrites all the assumptions too.
;; ;smashes 'dag-array and 'dag-parent-array
;; ;may be able to reuse dag-array?
;; ;returns (mv provedp state)
;; (defun prove-claim-with-axe-prover (claim miter-array-name miter-array
;;                                           max-nodenum ;largest nodenum mentioned in claim
;;                                           assumptions ;terms we can assume non-nil
;;                                           axe-rules-for-prover
;;                                           interpreted-function-alist monitored-runes
;;                                           extra-stuff test-cases ;these 2 are just used in mitering? drop them from this function?
;;                                           print
;;                                           case-name ;a string
;;                                           unroll
;;                                           state)
;;   (declare (xargs :mode :program
;;                   :stobjs state))
;;   (let* ((dag-len (+ 1 max-nodenum)) ;length of the relevant portion of the dag
;;          (dag-array (new-array1 'dag-array (+ 100 dag-len))) ;gives it a little space to grow
;;          (dag-array (copy-array-vals max-nodenum miter-array-name miter-array 'dag-array dag-array)) ;could copy only supporting nodes but that would change the numbering..
;;          (negated-assumptions (cons-onto-all 'not (enlist-all assumptions))) ;make a negate-all? see negate-terms
;; ;using the runes from the table here is new:
;;          ;(runes-from-table (get-axe-prover-runes state)) ;Thu Jan 14 14:48:24 2010
;;          (rule-alist (make-rule-alist nil ;runes-from-table
;;                                       axe-rules-for-prover t;new
;;                                       (w state))) ;slow to keep redoing this?
;; ;newly removed:
;; ;         (rule-alist (make-rule-alist-simple axe-rules-for-prover t (table-alist 'axe-rule-priorities-table (w state))))
;;          (literals (cons claim negated-assumptions)) ;we prove that either the claim is true or some assumption is false
;;          )
;;     ;;make auxiliary dag data structures:
;;     (mv-let
;;      (dag-parent-array dag-constant-alist dag-variable-alist)
;;      (make-dag-indices 'dag-array dag-array 'dag-parent-array dag-len)
;;      ;;add the literals to the dag:
;;      (mv-let
;;       (literal-nodenums-or-quoteps dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist)
;;       (merge-trees-into-dag literals nil
;;                             dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
;;                             'dag-array 'dag-parent-array)
;;       (mv-let
;;        (provedp state)
;;        (prove-disjunction-with-axe-prover literal-nodenums-or-quoteps
;;                                       dag-array dag-len dag-parent-array dag-constant-alist dag-variable-alist
;;                                       rule-alist interpreted-function-alist monitored-runes
;;                                       extra-stuff test-cases ;these 2 are just used in mitering?
;;                                       print
;;                                       case-name
;;                                       nil ;don't miter (so this won't generate any lemmas)
;;                                       (empty-analyzed-function-table) ;ffffixme? should prove-disjunction-with-axe-prover return the analyzed-function-table
;;                                       axe-rules-for-prover
;;                                       unroll
;;                                       state)
;;        ;just print the message in the subroutine and don't case split here?
;;        (if provedp
;;            (prog2$ (cw "proved ~s0 with dag prover~%" case-name)
;;                    (mv t state))
;;          (prog2$ (cw "failed to prove ~s0 with dag prover~%" case-name)
;;                  (mv nil state))))))))

;; ;we repeatedly tranform the graph replacing sets of probably-equal-node-that-needs-to-be-replaced-nodes with variables and replacing probably-constant nodes with quoteps (should we check whether such nodes already are quoteps?), generating lemmas to justify the changes we make, and each time yielding a graph such that if the final graph always has t for the top node, so does the initial graph (but not necessarily vice versa)

;; the nodes-to-be-replaced are the nodes that are wither or both

;; repeatedly replace safe nodes
;;  a safe node is one with no nodes-to-be-replaced on any path between it and any leaf (variable or constant).   we can't regret doing the replacement on such a node
;;  a set of nodes is safe only is all the nodes in the set are
;;  to replace a probably-constant node, just generate a lemma that the node is equal to that constant (hmmm. i can imagine this failing if we don't bit blast the mult) and put in a few variable for the node (fixing up the callers), width lemma too?
;;  for a set, gotta do all at once

;; if no safe nodes can be replaced but we are not done, give an error

;; cool!  i guess the probably constant stuff handles the top node too?  but the program needs to check before saying "ok"

;; (defun gen-lemmas-to-prove-dag-is-t-fn (dag test-case-count var-type-alist state rand print debug-nodes cut-proofs)
;;   (declare (xargs :guard t
;;                   :mode :program
;;                   :stobjs (state rand)
;;                   :verify-guards nil))
;;   (mv-let (sig-alist rand)
;;           (prog2$ (if print (cw "Making signature alist...~%" nil) nil)
;;                   (make-signature-alist dag test-case-count rand))
;;           (mv-let (lems state)
;;                   (gen-lemmas-to-prove-dag-is-t-helper sig-alist dag var-type-alist print debug-nodes state cut-proofs)
;;                   (mv nil ;error flag?
;;                       (cons 'progn lems)
;;                       state
;;                       rand))))


; out-of-date
;; (defun attempt-full-equivalence-proof (nodenum1
;;                                        nodenum2
;;                                        dag-array
;;                                        dag-len
;;                                        var-type-alist
;;                                        print
;;                                        array-type-alist
;;                                        array-value-assertion-alist
;;                                        state)
;;   (declare (xargs :mode :program)
;;            (ignore print))
;;   (let* ( ;save the old top node:
;;          (old-top-node (aref1 'dag-array dag-array (+ -1 dag-len)))

;;          ;;temporarily change the top node to the equality we're interested in:
;;          (equality-expr `(equal ,nodenum1 ,nodenum2))
;;          (dag-array (aset1 'dag-array dag-array (+ -1 dag-len) equality-expr)))
;;     (mv-let (translation-tag-array
;;              ;;var-type-alist
;;              num-nodes-to-translate)
;;             (gather-nodes-for-translation ;this one does no replacement
;;              (+ -1 dag-len)
;;              dag-array
;;              ;; var-type-alist
;;              (aset1 'needed-for-node1-tag-array (new-array1 'needed-for-node1-tag-array dag-len) nodenum1 t)
;;              (aset1 'needed-for-node2-tag-array (new-array1 'needed-for-node2-tag-array dag-len) nodenum2 t)
;;              ;; (new-array1 'replacement-tag-array dag-len)
;;              ;; we will translate the top node (the equality we just put in temporarily)
;;              (aset1 'translation-tag-array (new-array1 'translation-tag-array dag-len) (+ -1 dag-len) t)

;;              0 ;we don't count the top node, since it doesn't have a set of parens, which is really what we're counting here...
;;              )
;;             ;; (declare (ignore replacement-tag-array))
;;             ;; Call STP on the proof obligation without replacement:
;;             (mv-let (erp result state)
;;                     (prove-equal-with-axe+ -with-stp dag-array
;;                                         dag-len
;;                                         translation-tag-array
;;                                         (string-append "/tmp/tmpstpfilefull" (nat-to-string nodenum1))
;;                                         var-type-alist
;;                                         num-nodes-to-translate
;;                                         array-type-alist
;;                                         array-value-assertion-alist
;;                                         nil ;nodes made into vars (none in this case)
;;                                         state)
;;                     (mv erp
;;                         result
;;                         ;; put the top node back:
;;                         (aset1 'dag-array
;;                                dag-array
;;                                (+ -1 dag-len)
;;                                old-top-node)
;;                         state)))))

;elements of vars-lst are symbols or nodenums
;think through this again?
;; (defun generate-hyps-for-vars (vars-lst dag-array var-type-alist)
;;   (if (atom vars-lst)
;;       nil
;;     (let* ((var (car vars-lst)))
;;       (if (symbolp var)
;;           (let ((possible-match (lookup-eq var var-type-alist)))
;;             (if possible-match
;;                 (cons `(unsigned-byte-p ,possible-match ,var)
;;                       (generate-hyps-for-vars (cdr vars-lst) dag-array var-type-alist))
;;               (hard-error 'generate-hyps-for-vars "Failed to find ~x0 in the var-type-alist." (acons #\0 var nil))))
;;         ;;otherwise, it's a nodenum
;;         (let* ((expr (aref1 'dag-array dag-array var)))
;;           (if (symbolp expr)
;;               (let ((possible-match (lookup-eq expr var-type-alist)))
;;                 (if possible-match
;;                     (cons `(unsigned-byte-p ,possible-match ,expr)
;;                           (generate-hyps-for-vars (cdr vars-lst) dag-array var-type-alist))
;;                   (hard-error 'generate-hyps-for-vars "Failed to find ~x0 in the var-type-alist for node ~x1.." (acons #\1 var (acons #\0 expr nil)))))
;;             (if (quotep expr)
;;                 (hard-error 'generate-hyps-for-vars "Can't find a size for the replaced constant node.." (acons #\0 var nil))
;;               ;;to prevent this error, get rid of constant nodes first!
;;               ;;otherwise, it's a function call, and we should be able to tell the size (all our functions are sized now?)
;;               ;;BBOZO what if the size is not a natp (e.g., for a boolean or array)?
;;               (cons `(unsigned-byte-p ,(get-size-of-expr expr) ,(mypackn (list "VAR" var)))
;;                     (generate-hyps-for-vars (cdr vars-lst) dag-array var-type-alist)))))))))
;; (skip -proofs (verify-guards generate-hyps-for-vars))

;; (defun make-signature-array (n len dag-array var-signature-alist test-case-count signature-array)
;;   (declare (xargs :measure (+ 1 (nfix (- len n)))))
;;   (if (or (not (natp n))
;;           (not (natp len))
;;           (prog2$ (if (equal 0 (mod n 10000)) (cw "Node number: ~x0.~%" n) nil)
;;                   (>= n len)))
;;       signature-array
;;     (let* ((expr (aref1 'dag-array dag-array n)))
;;       (if (variablep expr)
;;           (make-signature-array (+ 1 n) len dag-array var-signature-alist test-case-count
;;                                 (aset1 'signature-array signature-array n (lookup-eq expr var-signature-alist)))
;;         (if (quotep expr)
;;             (make-signature-array (+ 1 n) len dag-array var-signature-alist test-case-count
;;                                   (aset1 'signature-array signature-array n (repeat test-case-count (unquote expr))))
;;           ;;function call
;;           (let* ((sigs-of-args (get-sigs-of-nodenums-or-quoteps (fargs expr) test-case-count signature-array))
;;                  (signature (eval-fn-lst (ffn-symb expr) sigs-of-args)))
;;             (make-signature-array (+ 1 n) len dag-array var-signature-alist test-case-count
;;                                   (aset1 'signature-array signature-array n signature))))))))

;; (skip -proofs (verify-guards make-signature-array))

;; ;now returns an array!
;; (defun make-signature-alist2 (dag-array dag-len var-type-alist test-case-count rand)
;;   (declare (xargs :stobjs (rand)
;;                   :guard (natp test-case-count)
;;                   :verify-guards nil
;;                   ))
;;   (mv-let (var-signature-alist rand)
;;           (make-var-signature-alist test-case-count var-type-alist rand nil)
;;           (mv (make-signature-array 0
;;                                     dag-len
;;                                     dag-array
;;                                     var-signature-alist
;;                                     test-case-count
;;                                     (new-array1 'signature-array dag-len)
;;                                     )
;;               rand)))

;; (skip -proofs (verify-guards make-signature-alist2))
;=== new stuff:

;; (defun make-var-signature-alist (test-case-count var-type-alist rand acc)
;;   (declare (xargs :stobjs (rand)
;;                   :guard (natp test-case-count)
;;                   :verify-guards nil
;;                   ))
;;   (if (atom var-type-alist)
;;       (mv acc rand)
;;     (let* ((entry (car var-type-alist))
;;            (var (car entry))
;;            (size (cdr entry)))
;;       (mv-let (vals rand)
;;               (genrandoms test-case-count (expt 2 size) rand)
;;               (make-var-signature-alist test-case-count
;;                                         (cdr var-type-alist)
;;                                         rand
;;                                         (acons var vals acc))))))

;; (skip -proofs (verify-guards make-var-signature-alist))

;; (defun get-sigs-of-nodenums-or-quoteps (items test-case-count signature-array)
;;   (if (atom items)
;;       nil
;;     (let ((item (car items)))
;;       (if (quotep item)
;;           (cons (repeat test-case-count (unquote item))
;;                 (get-sigs-of-nodenums-or-quoteps (cdr items) test-case-count signature-array))
;;         (cons (aref1 'signature-array signature-array item)
;;               (get-sigs-of-nodenums-or-quoteps (cdr items) test-case-count signature-array))))))

;; (skip -proofs (verify-guards get-sigs-of-nodenums-or-quoteps))

;; ;set all values of the array to nil, in an attempt to get the old values to be garbage-collected
;; (defun nil-out-array (n array-name array)
;;   (declare (xargs :measure (nfix (+ 1 n))))
;;   (if (or (< n 0)
;;           (not (integerp n)))
;;       array
;;     (nil-out-array (+ -1 n) array-name (aset1 array-name array n nil))))

;; (defun no-parent-is-a-bvif (nodenums dag-array)
;;   (if (atom nodenums)
;;       t
;;     (let ((expr (aref1 'dag-array dag-array (car nodenums))))
;;       (and (not (and (consp expr)
;;                      (equal 'bvif (car expr))))
;;            (no-parent-is-a-bvif (cdr nodenums) dag-array)))))

;; (defun okay-entry (expr nodenum dag-array parent-array)
;;   (or (variablep expr)
;;       (fquotep expr) ;okay?
;;       (not (equal 'bvif (ffn-symb expr)))
;;       ;;if we're here, expr must be a function call that's a bvif
;;       ;;NEW HEURISTIC:
;;       ;;we are now trying the approch of not considering for probable-equality any bvif node which is
;;       ;;the child of a bvif node (so we only consider the top nodes of bvif nests)
;;       (no-parent-is-a-bvif (aref1 'parent-array parent-array nodenum) dag-array)))

;; ;returns (mv matches rest-of-entries)
;; (defun find-okay-entries-with-sig (entries sig dag-array parent-array acc)
;;   (if (endp entries)
;;       (mv acc entries)
;;     (let* ((entry (car entries))
;;            (nodenum (car entry))
;;            (sig2 (cdr entry)))
;;       (if (equal sig sig2)
;;           (let ((expr (aref1 'dag-array dag-array nodenum)))
;;             (if (okay-entry expr nodenum dag-array parent-array)
;;                 (find-okay-entries-with-sig (cdr entries) sig dag-array parent-array (cons nodenum acc))
;;               (find-okay-entries-with-sig (cdr entries) sig dag-array parent-array acc)))
;;         ;;stop looking, since the sigs are sorted and we found a difference
;;         (mv acc entries)))))



;; ;we group together entries with the same cdrs unless they are disallowed...
;; (skip -proofs
;;  (defun group-same-entries-if-okay (entries dag-array parent-array acc)
;;    (if (atom entries)
;;        acc
;;      (let* ((entry (car entries))
;;             (nodenum (car entry))
;;             (expr (aref1 'dag-array dag-array nodenum)))
;;        (if (okay-entry expr nodenum dag-array parent-array)
;;            (let ((sig (cdr entry)))
;;              (if (or (all-natp sig) ;we only handle nodes that are bit vectors (what about 't?)
;;                      ;we now consider bv-array-write terms for probable equality (but not, e.g., cons nests)
;;                      (and (consp expr)
;;                           (equal 'bv-array-write (car expr))))
;;                  (mv-let (set entries)
;;                          (find-okay-entries-with-sig (cdr entries) sig dag-array parent-array nil)
;;                          (if (>= (len set) 1)
;;                              (group-same-entries-if-okay entries dag-array parent-array (cons (cons nodenum set) acc))
;;                            (group-same-entries-if-okay entries dag-array parent-array acc)))
;;                (group-same-entries-if-okay (cdr entries) dag-array parent-array acc)))
;;          (group-same-entries-if-okay (cdr entries) dag-array parent-array acc))))))

;; (defun find-sets-of-probably-equal-nodes2 (signature-alist dag-array parent-array)
;;   (let* (;(print t) ;so printit3 below works
;;          (sorted-signature-alist ;(printit2
;;           (prog2$ (cw "Merge sorting sig alist (len is ~x0)...~%" (len signature-alist))
;;                   (merge-sort-sig-< signature-alist))
;; ;)
;;           ))
;;     (prog2$ (cw "Grouping entries...~%" (len sorted-signature-alist))
;;             (group-same-entries-if-okay sorted-signature-alist dag-array parent-array nil))))

;; ;quoteps and variables are initially safe
;; (defun mark-initital-safe-nodes (dag tag-alist)
;;   (declare (xargs :guard t
;;                   :verify-guards nil)
;;            )
;;   (if (endp dag)
;;       tag-alist
;;     (let* ((entry (car dag))
;;            (expr (cdr entry)))
;;       (if (or (not (consp expr))
;;               (fquotep expr))
;;           (mark-initital-safe-nodes (cdr dag) (set-node-tag (car entry) *safe* t tag-alist))
;;         (mark-initital-safe-nodes (cdr dag) tag-alist)))))



;; (defun get-nodenums-to-be-replaced (nodenums tag-array)
;;   (if (endp nodenums)
;;       nil
;;     (if (or (get-node-tag (car nodenums) *probably-equal-node-that-needs-to-be-replaced* tag-array)
;;             (get-node-tag (car nodenums) *probable-constant-that-needs-to-be-replaced* tag-array))
;;         (cons (car nodenums)
;;               (get-nodenums-to-be-replaced (cdr nodenums) tag-array))
;;       (get-nodenums-to-be-replaced (cdr nodenums) tag-array))))



;; (defun get-wait-sets (nodenums tag-array)
;;   (if (endp nodenums)
;;       nil
;;     (union$ (get-node-tag (car nodenums) *wait-set* tag-array)
;;                (get-wait-sets (cdr nodenums) tag-array))))

;; ;go bottom up, computing wait sets
;; (skip -proofs
;;  (defun compute-intial-wait-sets (nodenum len dag-array tag-array)
;;    (declare (xargs :guard t
;;                    :verify-guards nil))
;;    (if (>= nodenum len)
;;        tag-array
;;      (let* ((expr (aref1 'dag-array dag-array nodenum))
;;             (wait-set (if (or (not (consp expr))
;;                               (fquotep expr))
;;                           nil ;variables and constants have nil wait-sets
;;                         (let* ((children (fargs expr))
;;                                ;;could avoid consing up this list?
;;                                (node-children (keep-non-quoteps children))
;;                                (children-to-be-replaced (get-nodenums-to-be-replaced node-children tag-array))
;;                                ;bozo use an eql version (or filter both kinds of children at once
;;                                (children-to-not-be-replaced (set-difference-equal node-children children-to-be-replaced))
;;                                (children-wait-sets (get-wait-sets children-to-not-be-replaced tag-array)))
;;                           (union$ ;append ;;this change my not make much difference
;;                            children-to-be-replaced children-wait-sets)))))
;;        (compute-intial-wait-sets (+ 1 nodenum)
;;                                  (prog2$ ;nil
;;                                   (cw "Nodenum: ~x0. Wait set: ~x1.~%" nodenum 'dummy)
;;                                          len)
;;                                  dag-array
;;                                  (set-node-tag nodenum *wait-set* wait-set tag-array))))))


;could instead keep a count of nodes left to replace?
;; (defun all-nodes-are-variables-or-constants (dag)
;;   (if (endp dag)
;;       t
;;     (let* ((entry (car dag))
;;            (expr (cdr entry)))
;;       (and (or (not (consp expr))
;;                (fquotep expr))
;;            (all-nodes-are-variables-or-constants (cdr dag))))))

;; (defun make-children-alist-aux (dag acc)
;;   (if (endp dag)
;;       acc
;;     (let* ((entry (car dag))
;;            (nodenum (car entry))
;;            (expr (cdr entry))
;;            )
;;       (if (not (consp expr)) ;variables have no children
;;           (make-children-alist-aux (cdr dag) (aset1 'children-array acc nodenum nil))
;;         (if (fquotep expr) ;constants have no children
;;             (make-children-alist-aux (cdr dag) (aset1 'children-array acc nodenum nil))
;;           ;function call
;;           (make-children-alist-aux (cdr dag) (aset1 'children-array acc nodenum (keep-non-quoteps (fargs expr)))))))))

;; (defun make-children-alist (dag)
;;   (make-children-alist-aux dag (new-array1 'children-array (len dag))))

;; (defun all-safe (nodenums tag-alist)
;;   (if (endp nodenums)
;;       t
;;     (and (get-node-tag (car nodenums) *safe* tag-alist)
;;          (all-safe (cdr nodenums) tag-alist))))

;i should write up the structure of tag-alist. basically, (*probably-equal-node-that-needs-to-be-replaced*
;gets bound to node-set (if any), *probable-constant-that-needs-to-be-replaced* gets bound to the quoted
;constant (if any)

;; (defun none-tagged-for-replacement (nodenums tag-alist)
;;   (if (endp nodenums)
;;       t
;;     (and (not (get-node-tag (car nodenums) *probably-equal-node-that-needs-to-be-replaced* tag-alist))
;;          (not (get-node-tag (car nodenums) *probable-constant-that-needs-to-be-replaced* tag-alist))
;;          (none-tagged-for-replacement (cdr nodenums) tag-alist))))

;; ;a node becomes safe if all of its children are safe and are not tagged for replacement
;; ;we walk up the tag-alist from bottom to top
;; (skip -proofs
;;  (defun propagate-safe-tags-aux (start-nodenum tag-alist len children-alist)
;;    (if (>= start-nodenum len)
;;        tag-alist
;;      (if (and (not (get-node-tag start-nodenum *safe* tag-alist)) ;if it's already safe, do nothing
;;               (let ((children (aref1 'children-array children-alist start-nodenum)))
;;                 (and (all-safe children tag-alist)
;;                      (none-tagged-for-replacement children tag-alist))))
;;          (propagate-safe-tags-aux (+ 1 start-nodenum)
;;                                   (set-node-tag start-nodenum *safe* 't tag-alist)
;;                                   len
;;                                   children-alist)
;;        (propagate-safe-tags-aux (+ 1 start-nodenum)
;;                                 tag-alist
;;                                 len
;;                                 children-alist)))))

;; ;wrapper for tracing
;; (defun propagate-safe-tags (start-nodenum tag-alist len children-alist)
;;   (propagate-safe-tags-aux start-nodenum tag-alist len children-alist))


;;   (let* ((node-set )
;; ;         (new-var (mypackn (cons "FRESH_VAR_FOR" (make-var-name-aux2 node-set))))
;;          )
            ;; (let* (
            ;; ;;BOZO improve the stuff involving the nil here
            ;; ;; the width of the fresh variable will be the minimum of the widths of the nodes it replaces
            ;; ;; any wider nodes must always have zeros in their top bits (otherwise, they can't be equal to a narrower value)
            ;; ;; ;bozo trying with MAX (failed to prove a width lemma due to info being lost when related terms get replaced with different vars)
            ;; ;; think about this more!
            ;; ; (new-var-width (min-of-entry-widths node-set dag var-size-alist))
            ;; ; (var-size-alist (acons new-var new-var-width var-size-alist))
            ;; ; (width-lemmas (make-width-lemmas node-set dag new-var-width var-size-alist print))
            ;; )

;; ;fixme - couldn't we just call try-to-express-target-tree-with-any-value repeatedly?
;; (skip -proofs
;;  (mutual-recursion
;;   ;;the target is a tree.  first we try to express the whole thing.  then we try to express each piece, recursively.
;;   ;;conceptually, this one takes a list of values, each with a name
;;   (defun try-to-express-target-tree-with-any-value (target-traces value-traces-lst value-term-lst target-term)
;;     (let ((whole-pattern (try-to-express-whole-target-with-any-candidate target-traces value-traces-lst value-term-lst)))
;;       (if whole-pattern
;;           `((equal ,target-term ,whole-pattern))
;;         (let* ((first-trace (car target-traces))
;;                (value (car first-trace)))
;;           ;;fixme, this assumes the return value is always the same shape
;;           (if (consp value)
;;               ;;deconstruct the values and try to express the pieces
;;               (try-to-express-target-tree-with-any-value-lst (get-nths-from-traces-rev (len value) target-traces)
;;                                                               value-traces-lst
;;                                                               value-term-lst
;;                                                               (make-nth-terms-rev (len value) target-term)
;;                                                               )
;;             nil)))))

;;   (defun try-to-express-target-tree-with-any-value-lst (target-traces-lst value-traces-lst value-term-lst target-term-lst)
;;     (if (endp target-traces-lst)
;;         nil
;;       (append (try-to-express-target-tree-with-any-value (car target-traces-lst) value-traces-lst value-term-lst (car target-term-lst))
;;               (try-to-express-target-tree-with-any-value-lst (cdr target-traces-lst) value-traces-lst value-term-lst (cdr target-term-lst)))))))

;; ;;returns a list of equalities (fixme- are the things dealt with here and in related functions always going to be equalities?)
;; (defun try-to-express-target-tree-with-any-values (target-traces target-term value-traces-lst value-term-lst)
;;   (if (endp value-traces-lst)
;;       nil
;;     (append (try-to-express-target-tree-with-any-value target-traces target-term (car value-traces-lst) (car value-term-lst))
;;             (try-to-express-target-tree-with-any-values target-traces target-term (cdr value-traces-lst) (cdr value-term-lst)))))

;; (defun try-to-express-target-trees-with-values (target-traces-lst target-term-lst value-traces-lst value-term-lst)
;;   (if (endp target-traces-lst)
;;       nil
;;     (append (try-to-express-target-tree-with-any-values (car target-traces-lst) (car target-term-lst) value-traces-lst value-term-lst)
;;             (try-to-express-target-trees-with-values (cdr target-traces-lst) (cdr target-term-lst) value-traces-lst value-term-lst))))


;; ;; array-info-alist now pairs array-infos with the generated names
;; ;needed only for klee-is-print-raw.lisp (that stuff may be out of date?)
;; (defun make-value-assertion-alist-for-arrays (array-info-alist)
;;   (if (endp array-info-alist)
;;       nil
;;     (let* ((entry (car array-info-alist))
;;            (array-info (car entry))
;;            (array-name (cdr entry))
;;            (array-data (g :value array-info))
;;            (element-size (g :element-width array-info))
;;            (length (g :element-count array-info))
;;            (index-size (integer-length (+ -1 length))))
;;       (s array-name
;;          (make-value-assertions-for-array array-data (symbol-name array-name) 0 index-size element-size)
;;          (make-value-assertion-alist-for-arrays (cdr array-info-alist))))))

;; ;needed only for klee-is-print-raw.lisp (that stuff may be out of date?)
;; (defun make-array-type-declaration-alist (array-size-alist)
;;   (if (endp array-size-alist)
;;       nil
;;     (let* ((entry (car array-size-alist))
;;            (array-name (car entry))
;;            (sizes (cdr entry))
;;            (element-size (car sizes))
;;            (index-size (cdr sizes)))
;;       (s array-name (concatenate 'string
;;                                  (symbol-name array-name)
;;                                  " : ARRAY BITVECTOR("
;;                                  (nat-to-string index-size)
;;                                  ") OF BITVECTOR("
;;                                  (nat-to-string element-size)
;;                                  ");"
;;                                  (newline-string))
;;          (make-array-type-declaration-alist (cdr array-size-alist))))))

;needed only for klee-is-print-raw.lisp? (that stuff may be out of date?)
;we can't directly translate something like (bv-array-read '8 '8 <index> '(0 0 0 0 0 0 0 0)) due to the quoted constant data
;so we replace such things with fresh array names and later generate ASSERTS about the values in those named arrays
;returns (mv array-info-alist dag-array)
;where array-info-alist pairs array-info records with the generated names
;we no longer require the data args to be constants, but if they are, this function handles them
;if they're not constants (e.g., bv-array-write expressions), this function leaves the corresponding nodes alone
;; (defun replace-arrays-with-names (n dag-len dag-array array-info-alist)
;;   (declare (xargs :measure (+ 1 (nfix (- dag-len n)))))
;;   (if (or (not (natp n))
;;           (not (natp dag-len))
;;           (>= n dag-len))
;;       (mv array-info-alist dag-array)
;;     (let ((expr (aref1 'dag-array dag-array n)))
;;       (if (consp expr)
;;           (let ((fn (ffn-symb expr)))
;;             (if (member-equal fn '(bvnth bv-array-read bv-array-write)) ;bbozo can we get rid of bvnth here and elsewhere?
;;                 (let ((data (if (equal fn 'bv-array-write)
;;                                 (sixth expr) ;for bv-array-write
;;                               (fifth expr) ;for bvnth and bv-array-read
;;                               )))
;;                   (if (quotep data) ;only do it if the data is a quoted constant
;;                       (let* ((constant-value (unquote data))
;;                              (element-width (unquote (second expr))) ; all three ops have the element-size first
;;                              (element-count (if (equal fn 'bvnth)
;;                                                 (expt 2 (unquote (third expr)))
;;                                               (unquote (third expr))))
;;                              ;bbozo check that the length of the constant data is consistent with the length given in the operator
;;                              (array-info (if (eql element-count (len constant-value))
;;                                              (s :value constant-value
;;                                                 (s :element-width element-width
;;                                                    (s :element-count element-count nil)))
;;                                            (hard-error 'replace-arrays-with-names "Constant array ~x0 is the wrong length (is ~x1 but should be ~x2)"
;;                                                        (acons #\0 constant-value (acons #\1 (len constant-value) (acons #\2 element-count nil))))))
;;                              (possible-match (lookup-equal array-info array-info-alist))
;;                              (array-name (if possible-match
;;                                              possible-match
;;                                            ;make a new name:
;;                                            (mypackn (list 'arrayvar (len array-info-alist)))))
;;                              (array-info-alist (if possible-match array-info-alist (acons array-info array-name array-info-alist)))
;;                              (new-expr (if (equal fn 'bv-array-write)
;;                                            (list fn (second expr) (third expr) (fourth expr) (fifth expr) array-name)
;;                                          ;;bvnth and bv-array-read:
;;                                          (list fn (second expr) (third expr) (fourth expr) array-name)))
;;                              ;; we put the array-name in place of the constant:
;;                              (dag-array (aset1 'dag-array dag-array n new-expr)))
;;                         (replace-arrays-with-names (+ 1 n) dag-len dag-array array-info-alist))
;;                     (replace-arrays-with-names (+ 1 n) dag-len dag-array array-info-alist)))
;;               (replace-arrays-with-names (+ 1 n) dag-len dag-array array-info-alist)))
;;         (replace-arrays-with-names (+ 1 n) dag-len dag-array array-info-alist)))))

;; (skip -proofs (verify-guards replace-arrays-with-names))

;; ;; array-info-alist now pairs array-infos with the generated names - this function sort of swaps the keys and values
;; (defun make-array-size-alist (array-info-alist)
;;   (if (endp array-info-alist)
;;       nil
;;     (let* ((entry (car array-info-alist))
;;            (array-info (car entry))
;;            (array-name (cdr entry))
;;            (element-size (g :element-width array-info))
;;            (length (g :element-count array-info))
;;            (index-size (integer-length (+ -1 length)))
;;            ;;BBOZO we guess the index size based on the array length
;;            ;;             (index-size (integer-length (+ -1 (len array-data))))
;;            )
;;       (acons array-name
;;              (cons element-size index-size)
;;              (make-array-size-alist (cdr array-info-alist))))))

;; ;ffixme compare this to identical-exprs-up-to-constant-inlining !
;; (skip -proofs
;;  (mutual-recursion
;; ;BOZO allow more stuff?
;; ;can the nodenums be quoteps?
;;   (defun nodes-structurally-equal (nodenum-or-quotep1 nodenum-or-quotep2 dag-array)
;;     (or (equal nodenum-or-quotep1 nodenum-or-quotep2)
;;         (let ((expr1 (if (atom nodenum-or-quotep1) (aref1 'dag-array dag-array nodenum-or-quotep1) nodenum-or-quotep1))
;;               (expr2 (if (atom nodenum-or-quotep2) (aref1 'dag-array dag-array nodenum-or-quotep2) nodenum-or-quotep2)))
;;           (if (or (quotep expr1) (quotep expr2))
;;               (equal expr1 expr2) ;bozo, what about two vars?
;;             (and (consp expr1)
;;                  (consp expr2)
;;                  (equal (len expr1) (len expr2))
;;                  (equal (ffn-symb expr1) (ffn-symb expr2))
;;                  (nodes-structurally-equal-lst (fargs expr1) (fargs expr2) dag-array))))))

;;   (defun nodes-structurally-equal-lst (nodenum-or-quotep1 nodenum-or-quotep2 dag-array)
;;     (if (atom nodenum-or-quotep1)
;;         t
;;       (and (nodes-structurally-equal (car nodenum-or-quotep1) (car nodenum-or-quotep2) dag-array)
;;            (nodes-structurally-equal-lst (cdr nodenum-or-quotep1) (cdr nodenum-or-quotep2) dag-array))))))




;returns (mv result new-runes new-fn-names state) where result is :ok, :error, or :failed
;ffixme why is the given node treated separately?
;ffixme use the result to try to prove the miter right after calling this function?
;; (defun gen-lemmas-for-rec-fn-and-supporting-nodes (nodenum2 node2-supporters dag-array interpreted-function-alist
;;                                                              extra-stuff
;;                                                             prover-rule-alist test-cases test-case-array-alist state)
;;   (declare (xargs :mode :program))
;;   (let* ((dummy2 (cw ",,First we generate lemmas for any supporting recursive functions.~%"))
;;          (supporting-rec-fn-nodes (filter-rec-fn-nodes node2-supporters dag-array state))
;;          (supporting-rec-fn-nodes (remove nodenum2 supporting-rec-fn-nodes)) ;is a node its own supporter??
;;          (supporting-rec-fn-nodes (merge-sort-< supporting-rec-fn-nodes))
;;          (dummy (cw ",,Supporting rec. fn. nodes: ~x0.~%" supporting-rec-fn-nodes)))
;;     (declare (ignore dummy dummy2))
;;     (mv-let (supporting-fn-runes-and-fns state)
;;             (analyze-rec-fns supporting-rec-fn-nodes dag-array interpreted-function-alist
;;                                 extra-stuff prover-rule-alist test-cases
;;                                nil ;not in axe-prover - are we sure?
;;                                test-case-array-alist
;;                                state)
;;             (prog2$ (cw ",,Generated stuff for supporting fns: ~x0~%" supporting-fn-runes-and-fns)
;;                     (mv-let (result state)
;;                             (analyze-rec-fn nodenum2
;;                                                             dag-array
;;                                                             interpreted-function-alist
;;                                                             extra-stuff
;;                                                             prover-rule-alist test-cases
;;                                                             nil ;fixme?
;;                                                             nil ;not in axe-prover - are we sure?
;;                                                             test-case-array-alist
;;                                                             state)
;;                             (prog2$ (cw "result: ~x0~%" result)
;;                                     (let* ((supporting-fn-runes (first supporting-fn-runes-and-fns))
;;                                            (supporting-fn-fns (second supporting-fn-runes-and-fns)))
;;                                       (if (eq :error result)
;;                                           (mv :error nil nil state)
;;                                         (if (eq :failed result)
;;                                             (mv :failed supporting-fn-runes supporting-fn-fns state)
;;                                           (mv :ok
;;                                               (append (first result) supporting-fn-runes)
;;                                               (append (second result) supporting-fn-fns)
;;                                               state))))))))))

;;   ;;repeat in reverse order? do it until it closes?
;;   ;;returns (mv facts changep state)
;;   (defun simplify-facts-aux (facts facts-acc changep print state)
;;     (declare (xargs :mode :program :stobjs state))
;;     (if (endp facts)
;;         (mv facts-acc changep state)
;;       (let ((fact (first facts)))
;;         (mv-let (result state)
;;                 (simplify-term3 fact
;;                                ;;ffixme more rules?
;;                                (make-rule-alist-simple
;;                                   (append (make-axe-rules (exit-test-simplification-rules) (w state))
;;                                        (make-axe-rules (booleanp-rules) (w state)) ;did not want turn-equal-around..
;;                                        (make-axe-rules (append '((:rewrite equal-of-constant-and-bvchop-when-bvlt) ;new!
;;                                                               (:rewrite bvlt-of-two-less-than-max-when-not-max)
;;                                                               (:rewrite EQUAL-OF-CONSTANT-AND-SLICE-WHEN-BVLT) ;new
;;                                                               (:REWRITE EQUAL-OF-BVCHOP-AND-CONSTANT-WHEN-NOT-BVLT-CONSTANT-2)
;;                                                               (:rewrite EQUAL-OF-CONSTANT-AND-SLICE-WHEN-EQUAL-OF-CONSTANT-AND-BVCHOP)
;;                                                               (:REWRITE BVLT-WHEN-BVCHOP-KNOWN-SUBST)
;;                                                               (:REWRITE BVCHOP-SUBST-CONSTANT)
;;                                                               (:rewrite BVLT-TRANSITIVE-1-A)
;;                                                               (:rewrite BVLT-TRANSITIVE-1-B)
;;                                                               (:rewrite BVLT-TRANSITIVE-2-A)
;;                                                               (:rewrite BVLT-TRANSITIVE-2-B)
;;                                                               (:rewrite not-equal-of-max-when-huge)
;;                                                               (:rewrite bvlt-when-equal-of-constant)
;;                                                               (:rewrite turn-equal-around-axe) ;hope this doesn't mess up the assumptions..
;;                                                               (:rewrite EQUAL-OF-T-WHEN-BOOLEANP) ;new..
;;                                                               (:rewrite EQUAL-OF-T-WHEN-BOOLEANP-ARG2) ;new require it to be a *known-predicates-except-not*, so make-equality-pairs can handle it? huh?  we now use the :known-booleans table
;;                                                               (:rewrite EQUAL-OF-NIL-WHEN-BOOLEANP) ;new
;;                                                               ) ;new
;;                                                             (base-rules)
;;                                                             (boolean-rules))
;;                                                     state))
;;                                :monitor '(bvlt-of-two-less-than-max-when-not-max)
;;                                :print print
;;                                :assumptions facts-acc
;;                                :normalize-xors nil)
;;                 (let ((result-term (dag2term result)))
;;                   (if (equal result-term *t*) ;skip any t..
;;                       (simplify-facts-aux (rest facts)
;;                                           facts-acc
;;                                           t ;something changed
;;                                           print
;;                                           state)
;;                     ;;fixme check for nils?
;;                     (simplify-facts-aux (rest facts)
;;                                         (cons result-term facts-acc)
;;                                         (or changep (not (equal result-term fact)))
;;                                         print
;;                                         state)))))))

;;   ;; returns (mv facts changep state)
;;   (defun simplify-facts-both-ways (facts print state)
;;     (declare (xargs :mode :program :stobjs state))
;;     (mv-let (facts changep state)
;;             (simplify-facts-aux facts nil nil print state)
;;             (mv-let (facts changep2 state)
;;                     (simplify-facts-aux facts ;(reverse facts)
;;                                         nil nil print state)
;;                     (mv facts (or changep changep2) state))))

;; ;fixme the both-ways thing seems awkward - what if two x and y are needed to simpify z and the order is x z y?
;;   (defun simplify-facts (facts print state)
;;     (declare (xargs :mode :program :stobjs state))
;;     (mv-let (facts changep state)
;;             (simplify-facts-both-ways facts print state)
;;             (if changep
;;                 (simplify-facts facts print state) ;what about loops?
;;               (mv facts state))))

;; ;fixme what if some list is empty?
;; (defun cars-all-equal (value lsts)
;;   (declare (xargs :guard (true-listp lsts)))
;;   (if (endp lsts)
;;       t
;;     (let ((lst (first lsts)))
;;       (and (if (consp lst) t (hard-error 'cars-all-equal "empty trace" nil))
;;            (equal value (car lst))
;;            (cars-all-equal value (rest lsts))))))

;; ;assumptions for a cipher that takes 3 arrays of bytes:
;; ;todo: move
;; (defun standard-assumptions2 (local-0-name
;;                               local-0-array-size
;;                               local-1-name
;;                               local-1-array-size
;;                               local-2-name
;;                               local-2-array-size heap)
;;   (declare (xargs :mode :program))
;;   `((equal (get-field (jvm::nth-local '0 locals) ',(array-contents-pair) ,heap) ,(symbolic-array local-0-name local-0-array-size 8))
;;     (equal (get-field (jvm::nth-local '1 locals) ',(array-contents-pair) ,heap) ,(symbolic-array local-1-name local-1-array-size 8))
;;     (equal (get-field (jvm::nth-local '2 locals) ',(array-contents-pair) ,heap) ,(symbolic-array local-2-name local-2-array-size 8))
;;     (array-refp-aux (jvm::nth-local '0 locals) (cons ',local-0-array-size 'nil) ':byte ,heap 'nil)
;;     (array-refp-aux (jvm::nth-local '1 locals) (cons ',local-1-array-size 'nil) ':byte ,heap 'nil)
;;     (array-refp-aux (jvm::nth-local '2 locals) (cons ',local-2-array-size 'nil) ':byte ,heap 'nil)))

;; (defun run-method-fn (name-of-constant-to-generate ;this will be a DAG representing the JVM state after running the method, in terms of the initial state
;;                       method-info
;;                       class-name)
;;   `(defconst-computed2 ,name-of-constant-to-generate
;;      (simplify-term2
;;       (build-run-term-for-method ,method-info
;;                                  'initial-locals
;;                                  '',class-name
;;                                  'initial-heap
;;                                  (setup-class-table 'initial-class-table)
;;                                  ;;fixme: standard assumption that the Object class (and nothing else) is already initialized:
;;                                  ''("java.lang.Object"))
;;       (list (make-axe-rules (jvm-rules) (w state)))
;;       ;;assumptions would go here
;;       )))

;; ; Generate a constant representing the effect of running the indicated method on a (most arbitrary) initial state.
;; (defmacro run-method (name-of-constant-to-generate ;this will be a DAG representing the JVM state after running the method, in terms of the initial state
;;                       method-info
;;                       class-name)
;;   (run-method-fn name-of-constant-to-generate ;this will be a DAG representing the JVM state after running the method, in terms of the initial state
;;                  method-info
;;                  class-name))

;; (defun prove-equal-with-axe+-fn (term1 term2
;;                           test-case-count input-type-alist
;;                           name
;;                           tests-per-case
;;                           print
;;                           debug-nodes
;;                           interpreted-function-alist
;;                           assumptions
;;                           runes
;;                           rules
;;                           rewriter-runes
;;                           prover-runes
;;                           initial-rule-set
;;                           initial-rule-sets
;;                           pre-simplify-rec-fnsp
;;                           extra-stuff
;;                           specialize-fnsp
;;                           monitor
;;                           use-context-when-miteringp
;;                           random-seed
;;                           unroll
;;                           max-conflicts
;;                           normalize-xors
;;                           state rand)
;;   (declare (xargs :stobjs (state rand)
;;                   :mode :program))
;;   (prove-with-axe (dagify-term `(equal ,term1 ,term2))
;;                test-case-count
;;                input-type-alist
;;                :name name
;;                :tests-per-case tests-per-case
;;                :print print
;;                :debug-nodes debug-nodes
;;                :interpreted-function-alist interpreted-function-alist
;;                :assumptions assumptions
;;                :runes runes
;;                :rules rules
;;                :rewriter-runes rewriter-runes
;;                :prover-runes prover-runes
;;                :initial-rule-set initial-rule-set
;;                :initial-rule-sets initial-rule-sets
;;                :pre-simplify-rec-fnsp pre-simplify-rec-fnsp
;;                :extra-stuff extra-stuff
;;                :specialize-fnsp specialize-fnsp
;;                :monitor monitor
;;                :use-context-when-miteringp use-context-when-miteringp
;;                :random-seed random-seed
;;                :unroll unroll
;;                :max-conflicts max-conflicts
;;                :normalize-xors normalize-xors))

;; ;TODO: start by making sure we can call STP on a simple example..
;; ;TODO: does this export a theorem?
;; ;TODO: add to this all keywords that prove-with-axe takes
;; (defmacro prove-equal-with-axe+ (term1 term2 &rest rest)
;;   `(make-event (prove-equal-with-axe+-fn ',term1
;;                                   ',term2
;;                                   ;;todo: check for extra keywords in rest
;;                                   ,(lookup-keyword-safe :test-case-count rest)
;;                                   ,(lookup-keyword-safe :input-type-alist rest)
;;                                   ,(lookup-keyword :name rest)
;;                                   ,(lookup-keyword :tests-per-case rest)
;;                                   ,(lookup-keyword :printp rest)
;;                                   ,(lookup-keyword :debug-nodes rest)
;;                                   ,(lookup-keyword :interpreted-function-alist rest)
;;                                   ,(lookup-keyword :assumptions rest)
;;                                   ,(lookup-keyword :runes rest)
;;                                   ,(lookup-keyword :rules rest)
;;                                   ,(lookup-keyword :rewriter-runes rest)
;;                                   ,(lookup-keyword :prover-runes rest)
;;                                   ,(lookup-keyword :initial-rule-set rest)
;;                                   ,(lookup-keyword :initial-rule-sets rest)
;;                                   ,(lookup-keyword :pre-simplify-rec-fnsp rest)
;;                                   ,(lookup-keyword :extra-stuff rest)
;;                                   ,(lookup-keyword :specialize-fnsp rest)
;;                                   ,(lookup-keyword :monitor rest)
;;                                   ,(lookup-keyword :use-context-when-miteringp rest)
;;                                   ,(lookup-keyword :random-seed rest)
;;                                   ,(lookup-keyword :unroll rest)
;;                                   ,(lookup-keyword :max-conflicts rest)
;;                                   ,(lookup-keyword :normalize-xors rest)
;;                                   state rand)))
