; In this file I prove the correctness of a static recursive factorial method
; on M5.  I'll follow our standard method.

#|
(include-book "m5-lemmas")
(certify-book "m5-fact" 1)
|#

(in-package "M5")

; [1] Specify the concepts related to what you're doing.

; [2] Write the program.

; [3] Specify how long it takes to execute.

; [4] Test the program and your scheduler.

; [5] Prove your program does what it does, starting with the
;     loop.

; [6] Prove what we do is what we want.

; [7] Put it all together.

; Concretely, for the  factorial code, here are the steps.

; [1] Specify the concepts related to what you're doing.
;     Typically we do it at two levels, 
;     (a) What we want.
;     (b) How we'll do it.
; But in the case of a recursive method like "fact", the two are
; the same!

(defun ! (n)
  (if (zp n)
      1
    (* n (! (- n 1)))))

; [2] Write the program.

(defconst *math-class*
  (make class
        :name "Math"
        :supers '("Object")
        :fields nil
        :methods
        (list (make method
                    :name "fact"
                    :formals '(n)
                    :sync nil
                    :code '((LOAD 0)
                            (IFEQ 8)
                            (LOAD 0)
                            (LOAD 0)
                            (CONST -1)
                            (ADD)
                            (INVOKESTATIC ("Math" "fact" 1))
                            (MUL)
                            (XRETURN)
                            (CONST 1)
                            (XRETURN))
                    :xtbl nil)
              (make method
                    :name "main"
                    :formals '()
                    :sync nil
                    :code '((CONST 12)
                            (CONST 5)
                            (INVOKESTATIC ("Math" "fact" 1))
                            (ADD)
                            (XRETURN))
                    :xtbl nil))))

; Note: We included a "main" method to show how we can use the correctness of
; "fact" later.  In the first part of this exercise, we will focus just on
; "fact".

; [3] Specify how long it takes to execute.

(defun fact-sched (id n)
  (if (zp n)
      (repeat id 5)   
    (append (repeat id 7)
            (append (fact-sched id (- n 1))
                    (repeat id 2)))))

; Note: This schedule counts from an INVOKESTATIC of "fact" through the
; corresponding XRETURN.

; [4] Test the program and your scheduler.

(set-ignore-ok t)

(defun fact-test (n)
  (top
   (stk
    (top-frame
     0
     (run (fact-sched 0 n)
          (modify 0 nil
                  :pc 0
                  :locs nil
                  :stk (push n nil)
                  :mloc '("Test" "test" 0)
                  :stat 'active
                  :ct (make-ct
                       (list 
                        (make class
                              :name "Test"
                              :supers '("Object")
                              :fields nil
                              :methods
                              (list
                               (make method
                                     :name "test"
                                     :formals nil
                                     :sync nil
                                     :code '((INVOKESTATIC ("Math" "fact" 1)))
                                     :xtbl nil)))

                        (make class
                              :name "Math"
                              :supers '("Object")
                              :fields nil
                              :methods
                              (list
                               (make method
                                     :name "fact"
                                     :formals '(n)
                                     :sync nil
                                     :code '((LOAD 0)
                                             (IFEQ 8)
                                             (LOAD 0)
                                             (LOAD 0)
                                             (CONST -1)
                                             (ADD)
                                             (INVOKESTATIC ("Math" "fact" 1))
                                             (MUL)
                                             (XRETURN)
                                             (CONST 1)
                                             (XRETURN))
                                     :xtbl nil)
                               (make method
                                     :name "main"
                                     :formals '()
                                     :sync nil
                                     :code '((CONST 12)
                                             (CONST 5)
                                             (INVOKESTATIC ("Math" "fact" 1))
                                             (ADD)
                                             (XRETURN))
                                     :xtbl nil)))))))))))

(defthm test-theorem
  (and (equal (fact-test 5) (! 5))
       (equal (fact-test 10) (! 10))
       (equal (fact-test 30) (! 30)))
  :rule-classes nil)

; [5] Prove your program does what it does, starting with the
;     loop.

; We want to focus on states that are poised to invoke our factorial program.
; So we define that concept.  Note that we have to assume the thread table is
; well-formed.  See m5-lemmas.lisp.

(defun poised-to-invoke-fact (n id s)
  (and (well-formed-ttp (tt s) 0)
       (natp id)
       (< id (len (tt s)))
       (equal (stat (find :id id (tt s))) 'ACTIVE)
       (equal (next-inst id s) '(INVOKESTATIC ("Math" "fact" 1)))
       (natp n)
       (equal (top (stk (top-frame id s))) n)
       (equal (find :name "Math" (ct s)) *math-class*)))

(defun fact-induct (n id s)
  (if (zp n)
      (list n id s)
    (fact-induct (- n 1)
                 id
                 (run (repeat id 7) s))))

(defthm fact-correct
  (implies (poised-to-invoke-fact n id s)
           (equal (run (fact-sched id n) s)
                  (modify id s
                          :pc (+ 1 -pc-)
                          :stk (push (! n) (pop -stk-)))))
  :hints (("Goal" :induct (fact-induct n id s))))

(in-theory (disable fact-sched))

; [6] Prove what we do is what we want.

; The theorem above does that.

; [7] Put it all together.

; The theorem above does that too.