(in-package "ACL2")

;; Author: Sandip Ray

;; This book provides a macro defsimulate+ which is an augmentation of
;; defsimulate with function invocation support.  This version only
;; supports partial correctness.

;; Note: This book depends on the existence of an include-book-dir
;; :symbolic that points to the top-level directory containing the
;; books.  For the current version I have:

;; (add-include-book-dir :symbolic "/u/sandip/Dropbox/research/projects/symbolic/starting-over")

;;; RBK: But I didn't like this, so I moved the include book to the
;;; top of the file.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Section 1: Basic functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; I include the ordinals and defp books since they are necessary for
;; the functions generated by defsimulate+.

;;; RBK: try different ordinal books, to prevent problems with
;;; arithmetic-5 compatibility.
(include-book "ordinals/limits" :dir :system)
(in-theory (disable o< o+ o- o* o^))
(local (include-book "arithmetic/top-with-meta" :dir :system))
(include-book "misc/defp" :dir :system)
(include-book "extended-partial-correctness")

(defun snoc (x e)
  (cond ((endp x) (list e))
        (t (cons (first x) (snoc (rest x) e)))))

(defun dellast (x)
  (cond ((endp x) nil)
        ((endp (rest x)) nil)
        (t (cons (first x) (dellast (rest x))))))


(defun lastval (x)
  (cond ((endp x) nil)
        ((endp (rest x)) (first x))
        (t (lastval (rest x)))))

(defun packn+ (x package)
  (declare (xargs :mode :program))
  (let ((ans (coerce (packn1 x) 'string)))
    (intern-in-package-of-symbol ans (pkg-witness package))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Section 2: The Heart of the functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; This function has a big bunch of parameters, but I think this is
;; manageable.  Most of the parameters are about tweaking function
;; names.

(defun defsimulate+-core
  (next run

   params

   subroutine-term insub existsexitpointsub stepstoexitpointsub
   stepstoexitpointsub-tail nextexitpointsub

   premain inmain cutpoint assertion modifymain
   exitsteps exists-next-exitpoint next-exitpoint
   correctness-theorem

   hints package)

  (declare (xargs :mode :program))

  (let* (
         ;; I have it drilled in my brain that the last parameter of
         ;; the function is the state component, and the first
         ;; parameter is the s0 (pre-state) component.

         (st (lastval params))
         (s0 (first params))

         ;; params includes both s0 and st.  params- does not include
         ;; s0.  Actually params- is used everywhere, --- params is
         ;; used only in assertion.

         (params- (rest params))
         (params+i (snoc params- 'i))
         (nextterm (list next st))
         (insubterm (cons insub params-))
         ;; RBK: Hmmm.  I had to comment these out.
         ;;(presubterm (cons '$$$presub params-))
         ;;(nextexitpointsubterm (cons nextexitpointsub params-))
         ;;(modifysubterm (cons '$$$modifysub params-))
         (cutterm (cons cutpoint params-))
         (premainterm (cons premain params-))
         (inmainterm (cons inmain params-))
         (existsexitpointsubterm (cons existsexitpointsub params-))
         (assertterm (cons assertion params))
         (modifyterm (cons modifymain params-))
         (exitsteps-tail (packn+ (list exitsteps '-tail) package))
         )
  `(encapsulate
    ()

    (local (deftheory user-theory (current-theory :here)))

    ;; First deal with generic requirements for subroutines.
    (local ,subroutine-term)


    ;; Now some easy theorems about the main program
    (local
     (defthm $$$pre-implies-assertion
      (implies ,premainterm
               (let ((,s0 ,st))
                 ,assertterm))
      :rule-classes nil))

    (local
     (defthm $$$assertion-main-implies-post
       (implies (and ,assertterm
                     (not ,inmainterm))
                (equal ,st
                       (let ((,st ,s0))
                         ,modifyterm)))
       :rule-classes nil))

    (local
     (defthm $$$assertion-implies-cutpoint
       (implies ,assertterm
                (or ,cutterm
                    (not ,inmainterm)))
       :rule-classes nil))

    ;;; RBK: made local
    (local
     (in-theory (theory 'ground-zero)))

    (local
     (defun-sk $$$exists-next-cutpoint ,params-
       (exists n
               (let* ((,st (,run ,st n)))
                ,cutterm))))



    (local
     (in-theory (union-theories (theory 'user-theory)
                                (list '$$$defp-symsim-theorem))))

    (local
     (defthm $$$assertion-invariant-over-cutpoints
       (implies (and ,assertterm
                     ,inmainterm
                     (let* ((,st (,run ,st n)))
                       (not ,inmainterm)))
                (let* ((,st (,next ,st))
                       (,st ($$$next-cutpoint-main
                             ,@params-)))
                  ,assertterm))
     :rule-classes nil
     :hints ,hints))

    ;;; RBK: made local
    (local
     (in-theory (theory 'ground-zero)))

    (defp ,exitsteps-tail ,params+i
      (if (not ,inmainterm) i
        (let* ((,st ,nextterm))
          (,exitsteps-tail ,@(snoc params- '(1+ i))))))



    (defun ,exitsteps ,params-
      (let* ((steps (,exitsteps-tail
                       ,@(snoc params- 0)))
             (,st (,run ,st steps)))
        (if (not ,inmainterm)
            steps
          (omega))))

    (defun-sk ,exists-next-exitpoint ,params-
      (exists n
              (let* ((,st (,run ,st n)))
                (not ,inmainterm))))

    (defun ,next-exitpoint ,params-
      (let* ((steps (,exitsteps ,@params-)))
        (,run ,st steps)))

    ;;; RBK: Moved to top of file, for ease of use.
    ;;;(local
    ;;; (include-book
    ;;;  "extended-partial-correctness" :dir :symbolic))

    (local
     (in-theory (theory 'minimal-theory)))

    (defthm ,correctness-theorem
      (implies (and ,premainterm
                    (,exists-next-exitpoint ,@params-))
               (and (let ((,st (,next-exitpoint ,@params-)))
                      (not ,inmainterm))
                    (equal (,next-exitpoint ,@params-)
                           ,modifyterm)))
  :otf-flg t
  :rule-classes nil
  :hints (("Goal"
           :use ((:instance
                  (:functional-instance
                   |epc composite partial correctness|
                   (epc-next (lambda (s) (let ((,st s)) ,nextterm)))
                   (epc-run (lambda (s n) (,run s n)))
                   (exists-epc-next-cutpoint
                    (lambda (s)
                      (let ((,st s))
                        ($$$exists-next-cutpoint ,@params-))))
                   (exists-epc-next-cutpoint-witness
                    (lambda (s)
                      (let ((,st s))
                          ($$$exists-next-cutpoint-witness ,@params-))))
                   (epc-pre-sub (lambda (s)
                              (let ((,st s)) ($$$presub ,@params-))))
                   (epc-in-sub (lambda (s)
                             (let((,st s)) ,insubterm)))
                   (epc-exists-exitpoint-sub
                    (lambda (s)
                      (let ((,st s)) ,existsexitpointsubterm)))
                   (epc-exists-exitpoint-sub-witness
                    (lambda (s)
                      (let ((,st s))
                        (,(packn+ (list existsexitpointsub '-witness)
                                  package)
                         ,@params-))))
                   (epc-steps-to-exitpoint-tail-sub
                    (lambda (s i)
                      (let ((,st s)) (,stepstoexitpointsub-tail ,@params+i))))
                   (epc-modify-sub
                    (lambda (s)
                      (let ((,st s))
                        ($$$modifysub ,@params-))))
                   (epc-next-exitpoint-sub
                    (lambda (s)
                      (let ((,st s))
                        (,nextexitpointsub  ,@params-))))
                   (epc-steps-to-exitpoint-sub
                    (lambda (s)
                      (let ((,st s))
                        (,stepstoexitpointsub ,@params-))))

                   (epc-pre-main (lambda (s)
                               (let ((,st s)) ,premainterm)))

                   (epc-cutpoint-main
                    (lambda (s)
                      (let ((,st s)) ,cutterm)))
                   (epc-exists-exitpoint-main
                    (lambda (s)
                      (let ((,st s))
                        (,exists-next-exitpoint ,@params-))))
                   (epc-exists-exitpoint-main-witness
                    (lambda (s)
                      (let ((,st s))
                        (,(packn+ (list exists-next-exitpoint
                                        '-witness)
                                  package)
                         ,@params-))))
                   (epc-next-exitpoint-main
                    (lambda (s)
                      (let ((,st s))
                        (,next-exitpoint ,@params-))))
                   (epc-exitsteps-main
                    (lambda (s)
                      (let ((,st s))
                        (,exitsteps ,@params-))))
                   (epc-exitsteps-main-tail
                    (lambda (s i)
                      (let ((,st s))
                        (,exitsteps-tail ,@params+i))))
                   (epc-in-main (lambda (s)
                              (let ((,st s)) ,inmainterm)))

                   (epc-next-epc-cutpoint-main
                    (lambda (s)
                      (let ((,st s))
                        ($$$next-cutpoint-main ,@params-))))
                   (epc-assertion-main
                    (lambda (s0 s)
                      (let ((,s0 s0)
                            (,st s))
                        ,assertterm)))
                   (epc-modify-main
                    (lambda (s)
                      (let ((,st s)) ,modifyterm))))
                  (s ,st))))

          ("Subgoal 22"
           :use ((:instance
                  $$$assertion-invariant-over-cutpoints
                  (,s0 s0)
                  (,st s))))
          ("Subgoal 21"
           :use ((:instance $$$assertion-main-implies-post
                            (,s0 s0)
                            (,st s))))
          ("Subgoal 20"
           :use ((:instance $$$pre-implies-assertion
                            (,st s))))
          ("Subgoal 19"
           :use ((:instance $$$assertion-implies-cutpoint
                            (,s0 s0)
                            (,st s))))
          ("Subgoal 18"
           :use ((:instance  $$$presub-implies-insub
                             (,st s))))
          ("Subgoal 17"
           :use ((:instance $$$in-sub-implies-in-main
                            (,st s))))
          ("Subgoal 16"
           :use ((:instance $$$no-main-cutpoint-in-sub
                            (,st s))))
          ("Subgoal 15"
           :use
           ((:instance
             (:definition $$$exists-next-cutpoint)
             (,st s))))

          ("Subgoal 14"
           :use
           ((:instance $$$exists-next-cutpoint-suff
                       (,st s))))
          ("Subgoal 13"
           :use
           ((:instance $$$next-cutpoint-main$def
                       (,st s))))
          ("Subgoal 12"
           :use ((:instance $$$correctness-of-sub
                            (,st s))))
          ("Subgoal 11"
           :use ((:instance
                  ,(packn+ (list stepstoexitpointsub-tail '$def)
                           package)
                  (,st s))))
          ("Subgoal 10"
           :use
           ((:instance
             (:definition ,existsexitpointsub)
             (,st s))))
          ("Subgoal 9"
           :use
           ((:instance
             ,(packn+ (list existsexitpointsub '-suff) package)
             (,st s))))
          ("Subgoal 8"
           :use
           ((:instance (:definition ,nextexitpointsub)
                       (,st s))))
          ("Subgoal 7"
           :use
           ((:instance (:definition ,stepstoexitpointsub)
                       (,st s))))

          ("Subgoal 6"
           :in-theory (enable ,run))

          ("Subgoal 5"
           :use ((:instance (:definition ,next-exitpoint)
                            (,st s))))
          ("Subgoal 4"
           :use ((:instance (:definition ,exitsteps)
                            (,st s))))
          ("Subgoal 3"
           :use ((:instance
                  ,(packn+ (list exitsteps-tail '$def) package)
                  (,st s))))
          ("Subgoal 2"
           :use ((:instance ,(packn+ (list exists-next-exitpoint
                                           '-suff)
                                     package)
                            (,st s))))
          ("Subgoal 1"
           :use ((:instance (:definition ,exists-next-exitpoint)
                            (,st s)))))))))



;; The following event will be only executed if the insub is provided
;; as nil.  This is because the main theorem does assume that we have
;; proven some correctness of the subroutine.


(defun process-default-subroutines
  (insub
   exists-exitpoint-sub
   steps-to-exitpoint-sub
   steps-to-exitpoint-sub-tail
   next-exitpoint-sub
   next run params inmain cutpoint)
  (let ((s (lastval params)))
    `(encapsulate
      ()


      (local (deftheory $$$subtheory (current-theory :here)))
      (local (in-theory (theory 'ground-zero)))

      (defun-nx ,insub ,params
         (declare (xargs :normalize nil))
         nil)

     (defun-nx $$$presub ,params
        nil)

      (defun-nx $$$modifysub ,params
        (declare (xargs :normalize nil))
        "Should never see this in a proof")

      (defthm $$$no-main-cutpoint-in-sub
        (implies (,insub ,@params)
                 (not (,cutpoint ,@params)))
        :rule-classes nil)


      (defthm $$$in-sub-implies-in-main
        (implies (,insub ,@params)
                 (,inmain ,@params))
        :rule-classes nil)

      (defthm $$$presub-implies-insub
        (implies ($$$presub ,@params)
                 (,insub ,@params))
        :rule-classes nil)


      (defp ,steps-to-exitpoint-sub-tail ,(snoc params 'i)
        (if (not (,insub ,@params))
            i
          (let* ((,s (,next ,s)))
            (,steps-to-exitpoint-sub-tail ,@(snoc params '(1+ i))))))

      (defun-nx ,steps-to-exitpoint-sub ,params
        (declare (xargs :normalize nil))
        (let* ((steps (,steps-to-exitpoint-sub-tail ,@(snoc params 0)))
               (,s (,run ,s steps)))
          (if (not (,insub ,@params))
              steps
            (omega))))

      (defun-nx ,next-exitpoint-sub ,params
        (,run ,s (,steps-to-exitpoint-sub ,@params)))

      (defun-sk ,exists-exitpoint-sub ,params
        (exists n
                (let* ((,s (,run ,s n)))
                  (not (,insub ,@params))))
        :witness-dcls ((declare (xargs :normalize nil))))

      (defthm $$$correctness-of-sub
        (implies (and ($$$presub ,@params)
                      (,exists-exitpoint-sub ,@params))
                 (and (let* ((,s (,next-exitpoint-sub ,@params)))
                        (not (,insub ,@params)))
                      (equal (,next-exitpoint-sub ,@params)
                             ($$$modifysub ,@params))))
        :rule-classes nil)

      (local (in-theory (theory 'ground-zero)))

      (defp $$$next-cutpoint-main ,params
        (if (or (,cutpoint ,@params)
                (not (,inmain ,@params)))
            ,s
          (let* ((,s (if ($$$presub ,@params)
                         ($$$modifysub ,@params)
                       (,next ,s))))
            ($$$next-cutpoint-main ,@params))))


      (defthm $$$defp-symsim-theorem
        (equal ($$$next-cutpoint-main ,@params)
               (if (or (,cutpoint ,@params)
                       (not (,inmain ,@params)))
                   ,s
                 ;;; RBK: ???
                 (let* ((,s (,next ,s)))
                   ($$$next-cutpoint-main ,@params))
                 ;;;($$$next-cutpoint-main ,@params)
                 ))
        :hints (("Goal"
                 :in-theory (enable $$$presub $$$modifysub)))))))

;; Now we get to the more non-trivial case, viz., when we actually do
;; have one or more subroutines.  The function
;; process-nontrivial-subroutine assumes that at least one subroutine
;; is present, so it should be called apropriately..

;; First a few auxilliary functions for accessing the different
;; components of subs.

(defun access-presub (sub params)
  (cons (first sub) params))

(defun access-modifysub (sub params)
  (cons (second sub) params))

(defun access-correctness-thm (sub)
  (third sub))

(defun construct-presub-list (subs params)
  (if (endp subs)
      nil
    (cons (access-presub (first subs) params)
          (construct-presub-list (rest subs) params))))

(defun construct-modifysub-list (subs params)
  (if (endp subs)
      nil
    (cons (access-presub (first subs) params)
          (construct-modifysub-list (rest subs) params))))

(defun construct-premodify-list (subs params)
  (if (endp subs)
      nil
    (cons (list (access-presub (first subs) params)
                  (access-modifysub (first subs) params))
            (construct-premodify-list (rest subs) params))))


;; The instance hint will be used in generating :use hint.  Maybe we
;; ought to use :cases hint, --- not decided on that yet.

(defun instance-hint (subs)
  (if (endp subs) nil
    (cons (list :instance (access-correctness-thm (first subs)))
          (instance-hint (rest subs)))))

(defun pre-modify-next-cutpoint (subs params next-cutpoint)
  (if (endp subs) nil
    (cons (list (access-presub (first subs) params)
                (cons next-cutpoint
                      (snoc (dellast params)
                            (access-modifysub (first subs) params))))
          (pre-modify-next-cutpoint (rest subs)
                                    params next-cutpoint))))

;; Here is the main function for processing the non-trivial
;; subroutines.

(defun process-nontrivial-subroutines
  (;; RBK: Hmmm.  run was not being used
   ;; next run params
   next params
   subs insub
   exists-exitpoint-sub next-exitpoint-sub
   cutpoint inmain)
  (let* ((presublist (construct-presub-list subs params))
         (s (lastval params))
         (pre-modify (construct-premodify-list subs params))
         (pre-modify-nc (pre-modify-next-cutpoint subs params '$$$next-cutpoint-main))
         (instance-hint (instance-hint subs)))

  `(encapsulate
    ()

    (local (deftheory subtheory (current-theory :here)))
    (local (in-theory (theory 'minimal-theory)))

    (defun-nx $$$presub ,params
      (declare (xargs :normalize nil))
      (or ,@presublist))

    (defun-nx $$$modifysub ,params
      (declare (xargs :normalize nil))
      (cond ,@(snoc pre-modify (list t s))))

    (defthm $$$presub-implies-insub
      (implies ($$$presub ,@params)
               (,insub ,@params))
      :hints (("Goal"
               :in-theory (union-theories (theory 'subtheory)
                                          (list '$$$presub '$$$modifysub))))
       :rule-classes nil)

    (defthm $$$no-main-cutpoint-in-sub
      (implies (,insub ,@params)
               (not (,cutpoint ,@params)))
      :hints (("Goal"
               :in-theory (union-theories (theory 'subtheory)
                                          (list '$$$presub '$$$modifysub))))
      :rule-classes nil)

    (defthm $$$in-sub-implies-in-main
      (implies (,insub ,@params)
               (,inmain ,@params))
      :hints (("Goal"
               :in-theory (union-theories (theory 'subtheory)
                                          (list '$$$presub '$$$modifysub))))
      :rule-classes nil)

    ;; One possible optimization is not to generate the subroutine
    ;; correctness theorem if there is only one subroutine (since the
    ;; user has already proven that theorem and I can just use that.
    ;; But we note that this theorem is anyways proven in a very tight
    ;; theory so that optimization is probably not worth it.

    (defthm $$$correctness-of-sub
      (implies (and ($$$presub ,@params)
                    (,exists-exitpoint-sub ,@params))
               (and (let* ((,s (,next-exitpoint-sub ,@params)))
                      (not (,insub ,@params)))
                    (equal (,next-exitpoint-sub ,@params)
                           ($$$modifysub ,@params))))
      :hints (("Goal"
               :in-theory (enable $$$presub $$$modifysub)
               :use ,instance-hint))
      :rule-classes nil)

    (local (in-theory (theory 'ground-zero)))

    (defp $$$next-cutpoint-main ,params
      (if (or (,cutpoint ,@params)
              (not (,inmain ,@params)))
          ,s
        (let* ((,s (if ($$$presub ,@params)
                       ($$$modifysub ,@params)
                     (,next ,s))))
          ($$$next-cutpoint-main ,@params)))
      :rule-classes nil)

    (defthm $$$defp-symsim-theorem
      (equal ($$$next-cutpoint-main ,@params)
             (if (or (,cutpoint ,@params)
                     (not (,inmain ,@params)))
                 ,s
               (cond ,@(snoc pre-modify-nc
                             `(t (let* ((,s (,next ,s)))
                                   ($$$next-cutpoint-main ,@params)))))))
      :hints (("Goal"
               :use ((:instance $$$next-cutpoint-main$def))
               :in-theory (enable $$$presub $$$modifysub)))))))

;; Now package this all up to a single function.

(defun defsimulate+-fn
  (next params run
   subs insub exists-exitpoint-sub
   steps-to-exitpoint-sub stepstoexitpointsub-tail
   next-exitpoint-sub
   precondition inmain cutpoint assertion modify
   exitsteps exists-next-exitpoint next-exitpoint
   correctness-theorem
   hints package)
  (declare (xargs :mode :program))

  (let* ((params- (rest params))
         (subroutine-term
          (if subs
              (process-nontrivial-subroutines
               ;; RBK:
               ;; next run params-
               next params-
               subs insub
               exists-exitpoint-sub next-exitpoint-sub
               cutpoint inmain)
            (process-default-subroutines
             insub
             exists-exitpoint-sub
             steps-to-exitpoint-sub
             stepstoexitpointsub-tail
             next-exitpoint-sub
             next run params- inmain cutpoint))))

          (defsimulate+-core
            next run

            params

            subroutine-term insub exists-exitpoint-sub steps-to-exitpoint-sub
            stepstoexitpointsub-tail next-exitpoint-sub

            precondition inmain cutpoint assertion modify
            exitsteps exists-next-exitpoint next-exitpoint
            correctness-theorem

            hints package)))

;; And finally write a macro to call that function.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Section 3: The User Interface
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defmacro defsimulate+
  (next
   &key
   (assertion-params '(s0 s1))
   (run '$$$run)
   (subs 'nil)
   (insub '$$$insub)
   (exists-exitpoint-sub '$$$exists-exitpoint-sub)
   (steps-to-exitpoint-sub '$$$steps-to-exitpoint-sub)
   (steps-to-exitpoint-sub-tail '$$$steps-to-exitpoint-sub-tail)
   (next-exitpoint-sub '$$$next-exitpoint-sub)
   (precondition '$$$main-precondition)
   (inmain '$$$in-main-program)
   (cutpoint '$$$main-cutpoint)
   (assertion '$$$main-assertion)
   (modify '$$$modify-main)
   (exitsteps '$$$main-steps-to-exitpoint)
   (exists-next-exitpoint '$$$exists-next-exitpoint)
   (next-exitpoint '$$$next-main-exitpoint)
   (correctness-theorem '$$$correctness-of-main)
   (hints 'nil)
   (package '"ACL2"))

  (declare (xargs :guard (and (consp assertion-params)
                              (symbol-listp assertion-params)
                              (>= (len assertion-params) 2)
                              (symbolp run)
                              (symbolp insub)
                              (symbolp exists-exitpoint-sub)
                              (symbolp steps-to-exitpoint-sub)
                              (symbolp steps-to-exitpoint-sub-tail)
                              (symbolp next-exitpoint-sub)
                              (symbolp precondition)
                              (symbolp inmain)
                              (symbolp cutpoint)
                              (symbolp assertion)
                              (symbolp modify)
                              (symbolp exitsteps)
                              (symbolp exists-next-exitpoint)
                              (symbolp next-exitpoint)
                              (symbolp correctness-theorem))))
  (defsimulate+-fn
    next assertion-params run

    subs insub exists-exitpoint-sub
    steps-to-exitpoint-sub steps-to-exitpoint-sub-tail
    next-exitpoint-sub

    precondition inmain cutpoint assertion modify

    exitsteps exists-next-exitpoint next-exitpoint

    correctness-theorem

    hints package))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  Section 4: Some testing
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(set-ignore-ok t)
(set-irrelevant-formals-ok t)

;; First one with no subroutine, just stress-testing the default.

(encapsulate
 ()

(local
 (defun try-next (s) s))

(local
 (defun try-run (s n)
   (if (zp n) s
     (try-run (try-next s) (- n 1)))))

(local
 (defun try-precondition (p q r)
   (declare (ignore p q r))
   nil))

(local
 (defun try-inmain (a b s)
   (declare (ignore a b s))
   t))

(local
 (defun try-cutpoint (a b s)
   (declare (ignore a b s))
   nil))

(local
(defun try-assertion (p a b s)
  (declare (ignore p a b s))
  nil))

(local
(defun try-modify (a b s)
  (declare (ignore a b s))
  nil))

(local
 (defsimulate+
   try-next
   :assertion-params (a p q st)
   :run try-run
   :assertion try-assertion
   :cutpoint try-cutpoint
   :precondition try-precondition
   :inmain try-inmain
   :modify try-modify)))

;; Second one, with more test.  Takes a while and can be commented out.

(encapsulate
 ()

 (local
  (defun try-next (s)
    (declare (xargs :normalize nil))
    s))

 (local
  (defun try-run (s n)
    (if (zp n) s
      (try-run (try-next s) (- n 1)))))


 (local
  (defun try-insub (p q s)
    t))

 (local
  (defun try-sub-precondition (p q s)
    (declare (xargs :normalize nil))
    nil))

 (local
  (defun try-sub-modify (p q s)
    (declare (xargs :normalize nil))
    s))

 (local
  (defp try-steps-to-exitpoint-tail-sub (p q st i)
    (if (not (try-insub p q st))
        i
      (try-steps-to-exitpoint-tail-sub p q (try-next st) (1+ i)))))

 (local
  (defun try-steps-to-exitpoint-sub (p q st)
    (declare (xargs :normalize nil))
    (let ((steps (try-steps-to-exitpoint-tail-sub p q st 0)))
     (if (not (try-insub p q (try-run st steps)))
         steps
       (omega)))))


 (local
  (defun try-next-exitpoint-sub (p q st)
    (try-run st (try-steps-to-exitpoint-sub p q st))))


 (local
  (defun-sk try-exists-exitpoint (p q st)
    (exists n (not (try-insub p q (try-run st n))))
    :witness-dcls  ((declare (xargs :normalize nil)))))

 (local
  (defthm correctness-of-try
   (implies (and (try-sub-precondition p q st)
                 (try-exists-exitpoint p q st))
            (and (not (try-insub p q (try-next-exitpoint-sub p q st)))
             (equal (try-next-exitpoint-sub p q st)
                   (try-sub-modify p q st))))))


 (local
  (defun try-precondition (p q r)
    (declare (ignore p q r))
    nil))

 (local
  (defun try-inmain (a b s)
    (declare (ignore a b s))
   t))

 (local
  (defun try-cutpoint (a b s)
    (declare (ignore a b s))
    nil))

 (local
  (defun try-assertion (p a b s)
    (declare (ignore p a b s))
    nil))

 (local
  (defun try-modify (a b s)
    (declare (ignore a b s))
    nil))


 (local
  (encapsulate
   ()
   (local
    (defsimulate+
      try-next
      :assertion-params (a p q st)
      :run try-run
      :assertion try-assertion
      :cutpoint try-cutpoint
      :precondition try-precondition
      :inmain try-inmain
      :modify try-modify))))

 (local
  (encapsulate
   ()
   (local
    (defsimulate+
      try-next
      :assertion-params (a p q st)
      :subs ((try-sub-precondition try-sub-modify correctness-of-try))
      :run try-run
      :assertion try-assertion
      :cutpoint try-cutpoint
      :precondition try-precondition
      :inmain try-inmain
      :modify try-modify
      :insub try-insub
      :exists-exitpoint-sub try-exists-exitpoint
      :correctness-theorem correctness-with-one-sub
      :steps-to-exitpoint-sub try-steps-to-exitpoint-sub
      :steps-to-exitpoint-sub-tail try-steps-to-exitpoint-tail-sub
      :next-exitpoint-sub try-next-exitpoint-sub))))

 (local
  (encapsulate
   ()
   (local
    (defsimulate+
      try-next
      :assertion-params (a p q st)
      :subs ((try-sub-precondition try-sub-modify correctness-of-try)
             (try-sub-precondition try-sub-modify correctness-of-try))
      :run try-run
      :assertion try-assertion
      :cutpoint try-cutpoint
      :precondition try-precondition
      :inmain try-inmain
      :modify try-modify
      :insub try-insub
      :exists-exitpoint-sub try-exists-exitpoint
      :correctness-theorem correctness-with-two-subs
      :steps-to-exitpoint-sub try-steps-to-exitpoint-sub
      :steps-to-exitpoint-sub-tail try-steps-to-exitpoint-tail-sub
      :next-exitpoint-sub try-next-exitpoint-sub))))

 )

