(in-package "ACL2")

(local (defun %%sub1-induction (n)
         (if (zp n)
             n
           (%%sub1-induction (1- n)))))

(local (defun %%and-tree-fn (args len)
         (declare (xargs :mode :program))
         (if (< len 20)
             (cons 'and args)
           (let* ((len2 (floor len 2)))
             (list 'and
                   (%%and-tree-fn (take len2 args) len2)
                   (%%and-tree-fn (nthcdr len2 args)
                                  (- len len2)))))))

(local (defmacro %%and-tree (&rest args)
         (%%and-tree-fn args (length args))))

(local (include-book "bvecp-raw"))

(local (include-book "rtl/rel4/lib/top"
                     :dir :system))

(local (include-book "rtl/rel4/lib/simplify-model-helpers"
                     :dir :system))

(include-book "model-raw")

(include-book "model")

(local (table user-defined-functions-table
         nil nil :clear))

(local (disable-forcing))

(local (deftheory theory-0 (theory 'minimal-theory)))

(local (defmacro %%p0-equalities nil
         '(%%and-tree (equal (out1$ n $path)
                             (foo$raw::out1$ n $path))
                      (equal (out2$ n $path)
                             (foo$raw::out2$ n $path)))))

(local (defun %%p0-aux (n $path)
         (declare (xargs :normalize nil))
         (%%p0-equalities)))

(local (defun-sk %%p0 (n)
         (forall ($path) (%%p0-aux n $path))))

(local (defthm %%p0-implies-%%p0-aux
         (implies (%%p0 n) (%%p0-aux n $path))))

(local (encapsulate nil
         (local (defthm %%p0-property-lemma
                  (implies (%%p0-aux n $path)
                           (%%p0-equalities))
                  :rule-classes nil
                  :instructions ((:dv 1)
                                 (:expand nil)
                                 :top
                                 (:generalize ((%%p0-equalities) eqs))
                                 :s)))
         (defthm %%p0-property
           (implies (%%p0 n) (%%p0-equalities))
           :instructions ((:use %%p0-property-lemma)
                          (:generalize ((%%p0-equalities) eqs))
                          :prove))))

(local
     (deftheory %%p0-implies-f-is-%f-theory
                (union-theories (set-difference-theories (current-theory :here)
                                                         (current-theory '%%p0))
                                (theory 'minimal-theory))))

(local (encapsulate nil
         (local (in-theory (disable %%p0-property)))
         (local (defthm out2$-is-out2$-base
                  (implies (zp n)
                           (equal (out2$ n $path)
                                  (foo$raw::out2$ n $path)))
                  :hints (("Goal" :expand ((out2$ n $path)
                                           (foo$raw::out2$ n $path))))))
         (local (defthm out1$-is-out1$-base
                  (implies (zp n)
                           (equal (out1$ n $path)
                                  (foo$raw::out1$ n $path)))
                  :hints (("Goal" :expand ((out1$ n $path)
                                           (foo$raw::out1$ n $path))))))
         (defthm %%p0-base
           (implies (zp n) (%%p0 n))
           :instructions (:promote :x-dumb (:s :normalize nil)))))

(local (encapsulate nil
         (local (in-theory (disable %%p0 %%p0-base)))
         (local (deflabel %%induction-start))
         (local (defthm out2$-is-out2$-induction_step
                  (implies (and (not (zp n)) (%%p0 (1- n)))
                           (equal (out2$ n $path)
                                  (foo$raw::out2$ n $path)))
                  :instructions (:promote (:dv 1)
                                          :x-dumb
                                          :nx :x-dumb
                                          :top (:s :normalize nil
                                                   :backchain-limit 1000
                                                   :expand :lambdas
                                                   :repeat 4))))
         (local (defthm out1$-is-out1$-induction_step
                  (implies (and (not (zp n)) (%%p0 (1- n)))
                           (equal (out1$ n $path)
                                  (foo$raw::out1$ n $path)))
                  :instructions (:promote (:dv 1)
                                          :x-dumb
                                          :nx :x-dumb
                                          :top (:s :normalize nil
                                                   :backchain-limit 1000
                                                   :expand :lambdas
                                                   :repeat 4))))
         (defthm %%p0-induction_step
           (implies (and (not (zp n)) (%%p0 (1- n)))
                    (%%p0 n))
           :instructions (:promote :x-dumb (:s :normalize nil)))))

(local
 (defthm %%p0-holds
  (%%p0 n)
  :hints
  (("Goal" :induct (%%sub1-induction n)
           :do-not '(preprocess)
           :in-theory (union-theories '(%%p0-base %%p0-induction_step
                                                  (:induction %%sub1-induction))
                                      (theory 'minimal-theory))))))

(ENCAPSULATE
 (
 )

 (local (in-theory (union-theories '(%%p0-holds)
                                   (theory '%%p0-implies-f-is-%f-theory))))

 (defthm out2$-is-out2$
   (equal (out2$ n $path)
          (foo$raw::out2$ n $path))
   :hints (("Goal" :do-not '(preprocess))))

 (defthm out1$-is-out1$
   (equal (out1$ n $path)
          (foo$raw::out1$ n $path))
   :hints (("Goal" :do-not '(preprocess))))

)

(deftheory %-removal-theory
           (union-theories '(out1$-is-out1$ out2$-is-out2$)
                           (theory 'minimal-theory)))

