; Problem set 7 answers

(include-book "m1-lemmas")

(begin-book t :ttags :all)

(in-package "M1")

; Problem 7-1:

#|
(compile
 '(n)
 '((a = 0)
   (while (n > 0)
     (a = (((a + n) + n) - 1))
     (n = (n - 1)))
   (return a)))
|#

; The bytecode program generated by the compiler:

(defconst *isquare-program*
  '((ICONST 0)   ;;;  0  
    (ISTORE 1)   ;;;  1  (a = 0)
    (ILOAD 0 )   ;;;  2  (while    ; loop pc = 2
    (IFLE 14)    ;;;  3   (n > 0)
    (ILOAD 1)    ;;;  4  
    (ILOAD 0)    ;;;  5  
    (IADD)       ;;;  6  
    (ILOAD 0)    ;;;  7  
    (IADD)       ;;;  8  
    (ICONST 1)   ;;;  9  
    (ISUB)       ;;; 10  
    (ISTORE 1)   ;;; 11   (a = (((a + n) + n) - 1))
    (ILOAD 0)    ;;; 12  
    (ICONST 1)   ;;; 13  
    (ISUB)       ;;; 14  
    (ISTORE 0)   ;;; 15   (n = (n - 1))
    (GOTO -14)   ;;; 16   ) ; return to top of loop
    (ILOAD 1)    ;;; 17  
    (HALT)))     ;;; 18   (return a)

; Problem 7-2:

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

; What we want:

(defun square (n)
  (* n n))

(defun square-rec (n)
  (if (zp n)
      0
    (+ n n -1 (square-rec (- n 1)))))

; How we'll do it: we will compute (isquare n 0), where (isquare n a) is:

(defun isquare (n a)
  (if (zp n)
      a
    (isquare (- n 1) (+ a n n -1))))

; [2] Write the program.

; See Problem 7-1.

; [3] Specify how long it takes to execute (starting with the loop).  Define a
;     scheduler function that will run this program to completion.

; To schedule the isquare program on n starting at the loop pc = 2: If n is 0,
; schedule 4 steps, namely the instructions at pcs 2, 3, 17, and 18, ending at
; the HALT. Otherwise, if n is not 0, schedule the 15 instructions at pcs 2
; through 16, ending back at pc = 2, and then schedule isquare for n - 1.

(defun sched-isquare-loop (n)
  (if (zp n)
      (repeat 0 4)
    (app (repeat 0 15)
            (sched-isquare-loop (- n 1)))))

; Schedule a complete isquare computation, starting at pc = 0.

(defun sched-isquare (n)
  (app (repeat 0 2)
          (sched-isquare-loop n)))

; [4] Test the program and your scheduler.

(defun test-isquare (n)
  (top
   (stack
    (run (sched-isquare n)
         (make-state 0
                     (cons n (cons 0 nil))
                     nil
                     *isquare-program*)))))

(defthm test-isquare-examples
  (and (equal (test-isquare 0) (isquare 0 0))
       (equal (test-isquare 2) (isquare 2 0))
       (equal (test-isquare 5) (isquare 5 0))
       (equal (test-isquare 10) (isquare 10 0)))
  :rule-classes nil)

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

(defthm isquare-loop-lemma
  (implies (and (natp n)
                (natp a))
           (equal (run (sched-isquare-loop n)
                       (make-state 2
                                   (cons n (cons a nil))
                                   stack
                                   *isquare-program*))
                  (make-state 18
                              (cons 0 (cons (isquare n a) nil))
                              (push (isquare n a) stack)
                              *isquare-program*))))

(defthm isquare-lemma
  (implies (natp n)
           (equal (run (sched-isquare n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *isquare-program*))
                  (make-state 18
                              (cons 0 (cons (isquare n 0) nil))
                              (push (isquare n 0) stack)
                              *isquare-program*))))

(in-theory (disable sched-isquare))

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

(defthm isquare-is-square-rec
  (implies (and (natp n)
                (natp a))
           (equal (isquare n a)
                  (+ a (square-rec n)))))

(defthm square-rec-is-square
  (implies (natp n)
           (equal (square-rec n) 
                  (square n))))

; [7]  Put it all together.

(defthm isquare-correct
  (implies (natp n)
           (equal (run (sched-isquare n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *isquare-program*))
                  (make-state 18
                              (cons 0 (cons (square-rec n) nil))
                              (push (square-rec n) stack)
                              *isquare-program*))))

(defthm isquare-correct-full
  (implies (natp n)
           (equal (run (sched-isquare n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *isquare-program*))
                  (make-state 18
                              (cons 0 (cons (square n) nil))
                              (push (square n) stack)
                              *isquare-program*))))

(defthm isquare-correct-corollary-1
  (implies (natp n)
           (equal (top
                   (stack
                    (run (sched-isquare n)
                         (make-state 0
                                     (cons n (cons a nil))
                                     stack
                                     *isquare-program*))))
                  (square n))))

(defthm isquare-correct-corollary-2
  (implies (natp n)
           (equal (top
                   (stack
                    (run (sched-isquare n)
                         (make-state 0
                                     (cons n (cons a nil))
                                     stack
                                     (compile
                                      '(n)
                                      '((a = 0)
                                        (while (n > 0)
                                          (a = (((a + n) + n) - 1))
                                          (n = (n - 1)))
                                        (return a)))))))
                  (square n))))

; Problem 7-3:

#|
(compile
 '(n)
 '((a = 0)
   (while (n > 0)
     (a = (a + (1 + (3 * (n * (n - 1))))))
     (n = (n - 1)))
   (return a)))
|#

; The bytecode program generated by the compiler:

(defconst *icube-program*
  '((ICONST 0)   ;;;  0
    (ISTORE 1)   ;;;  1  (a = 0)
    (ILOAD 0)    ;;;  2  (while    ; loop pc = 2
    (IFLE 18)    ;;;  3   (n > 0)
    (ILOAD 1)    ;;;  4
    (ICONST 1)   ;;;  5
    (ICONST 3)   ;;;  6
    (ILOAD 0)    ;;;  7
    (ILOAD 0)    ;;;  8
    (ICONST 1)   ;;;  9
    (ISUB)       ;;; 10
    (IMUL)       ;;; 11
    (IMUL)       ;;; 12
    (IADD)       ;;; 13
    (IADD)       ;;; 14
    (ISTORE 1)   ;;; 15     (a = (a + (1 + (3 * (n * (n - 1))))))
    (ILOAD 0)    ;;; 16
    (ICONST 1)   ;;; 17
    (ISUB)       ;;; 18
    (ISTORE 0)   ;;; 19   (n = (n - 1))
    (GOTO -18)   ;;; 20   ) ; return to top of loop
    (ILOAD 1)    ;;; 21
    (HALT)))     ;;; 22   (return a)

; Problem 7-4:

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

; What we want:

(defun cube (n)
  (* n n n))

(defun cube-rec (n)
  (if (zp n)
      0
    (+ (* 3 n (- n 1)) 1 (cube-rec (- n 1)) )))

; How we'll do it: we will compute (icube n 0), where (icube n a) is:

(defun icube (n a)
  (if (zp n)
      a
    (icube (- n 1) (+ a (* 3 n (- n 1)) 1))))

; [2] Write the program.

; See Problem 7-3.

; [3] Specify how long it takes to execute (starting with the loop).  Define a
;     scheduler function that will run this program to completion.

; To schedule the icube program on n starting at the loop pc = 2: If n is 0,
; schedule 4 steps, namely the instructions at pcs 2, 3, 21, and 22, ending at
; the HALT. Otherwise, if n is not 0, schedule the 19 instructions at pcs 2
; through 20, ending back at pc = 2, and then schedule icube for n - 1.

(defun sched-icube-loop (n)
  (if (zp n)
      (repeat 0 4)
    (app (repeat 0 19)
            (sched-icube-loop (- n 1)))))

; Schedule a complete icube computation, starting at pc = 0.

(defun sched-icube (n)
  (app (repeat 0 2)
          (sched-icube-loop n)))

; [4] Test the program and your scheduler.

(defun test-icube (n)
  (top
   (stack
    (run (sched-icube n)
         (make-state 0
                     (cons n (cons 0 nil))
                     nil
                     *icube-program*)))))

(defthm test-icube-examples
  (and (equal (test-icube 0) (icube 0 0))
       (equal (test-icube 2) (icube 2 0))
       (equal (test-icube 5) (icube 5 0))
       (equal (test-icube 10) (icube 10 0)))
  :rule-classes nil)

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

(defthm icube-loop-lemma
  (implies (and (natp n)
                (natp a))
           (equal (run (sched-icube-loop n)
                       (make-state 2
                                   (cons n (cons a nil))
                                   stack
                                   *icube-program*))
                  (make-state 22
                              (cons 0 (cons (icube n a) nil))
                              (push (icube n a) stack)
                              *icube-program*))))

(defthm icube-lemma
  (implies (natp n)
           (equal (run (sched-icube n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *icube-program*))
                  (make-state 22
                              (cons 0 (cons (icube n 0) nil))
                              (push (icube n 0) stack)
                              *icube-program*))))

(in-theory (disable sched-icube))

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

(defthm icube-is-cube-rec
  (implies (and (natp n)
                (natp a))
           (equal (icube n a)
                  (+ a (cube-rec n)))))

(defthm cube-rec-is-cube
  (implies (natp n)
           (equal (cube-rec n) 
                  (cube n))))

; [7]  Put it all together.

(defthm icube-correct
  (implies (natp n)
           (equal (run (sched-icube n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *icube-program*))
                  (make-state 22
                              (cons 0 (cons (cube-rec n) nil))
                              (push (cube-rec n) stack)
                              *icube-program*))))

(defthm icube-correct-full
  (implies (natp n)
           (equal (run (sched-icube n)
                       (make-state 0
                                   (cons n (cons a nil))
                                   stack
                                   *icube-program*))
                  (make-state 22
                              (cons 0 (cons (cube n) nil))
                              (push (cube n) stack)
                              *icube-program*))))

(defthm icube-correct-corollary-1
  (implies (natp n)
           (equal (top
                   (stack
                    (run (sched-icube n)
                         (make-state 0
                                     (cons n (cons a nil))
                                     stack
                                     *icube-program*))))
                  (cube n))))

(defthm icube-correct-corollary-2
  (implies (natp n)
           (equal (top
                   (stack
                    (run (sched-icube n)
                         (make-state 0
                                     (cons n (cons a nil))
                                     stack
                                     (compile
                                      '(n)
                                      '((a = 0)
                                        (while (n > 0)
                                          (a = (a + (1 + (3 * (n * (n - 1))))))
                                          (n = (n - 1)))
                                        (return a)))))))
                  (cube n))))

; Problem 7-5:

#|
(compile
 '(i)
 '((j = 1)
   (k = 1)
   (temp = 1)
   (if (i = 0)
       ((return j))
       ((while (i > 1)
         (temp = k)
         (k = (j + k))
         (j = temp)
         (i = (i - 1)))
        (return k)))))
|#

; The bytecode program generated by the compiler:

(defconst *ifib-program*
  '((ICONST 1) ; 0
    (ISTORE 1) ; 1    j = 1
    (ICONST 1) ; 2
    (ISTORE 2) ; 3    k = 1
    (ICONST 1) ; 4
    (ISTORE 3) ; 5    temp = 1
    (ILOAD 0)  ; 6    (if (i
    (ICONST 0) ; 7         != 0) jmp to 13
    (ISUB)     ; 8 
    (IFNE 4)   ; 9 
    (ILOAD 1)  ; 10   (if (i = 0) 
    (HALT)     ; 11             (return j))
    (GOTO 20)  ; 12 The compiler adds a GOTO to jump over the false branch; since the true branch ends in HALT, the GOTO never gets executed.
    (ILOAD 0)  ; 13   (while (i          ; loop: pc = 13
    (ICONST 1) ; 14             > 1)
    (ISUB)     ; 15
    (IFLE 14)  ; 16
    (ILOAD 2)  ; 17
    (ISTORE 3) ; 18     temp = k
    (ILOAD 1)  ; 19
    (ILOAD 2)  ; 20
    (IADD)     ; 21
    (ISTORE 2) ; 22     k = j + k
    (ILOAD 3)  ; 23
    (ISTORE 1) ; 24     j = temp
    (ILOAD 0)  ; 25
    (ICONST 1) ; 26
    (ISUB)     ; 27
    (ISTORE 0) ; 28     i = i - 1
    (GOTO -16) ; 29    ); end while
    (ILOAD 2)  ; 30    (return k)
    (HALT)))   ; 31

; Problem 7-6:

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

; (a) What we want:

(defun fib (i)
  (if (zp i)
      1
    (if (equal i 1)
        1
      (+ (fib (- i 1)) (fib (- i 2))))))

; (b) How we'll do it:  We'll compute (ifib i 1 1), where

(defun ifib (i j k)
  (if (zp i)
      j
    (if (equal i 1)
        k
    (ifib (- i 1) k (+ j k)))))

; [2] Write the program.

; See Problem 7-5

; [3] Specify how long it takes to execute (starting with the loop). Define a
;     scheduler function that will run this program to completion.

; We take care of the case when i = 0 before the while loop, but we include
; this case to simplify the admission of the function.

(defun sched-ifib-loop (i)
  (if (or (zp i) (equal i 1))
      (repeat 0 6)
    (app (repeat 0 17)
            (sched-ifib-loop (- i 1)))))

; To schedule the ifib program on i starting at the loop pc = 13: If i is 0,
; schedule no steps; if i is 1, schedule 6 steps, namely the instructions at
; pcs 13, 14, 15, 16, 30, and 31, ending at the HALT.  Otherwise, if i is not 0
; or 1, schedule the 17 instructions at pcs 13 through 29, ending back at pc =
; 13, and then schedule ifib for i-1.

; Schedule a complete ifib computation, starting at pc = 0.

(defun sched-ifib (i)
  (if (zp i)
    (repeat 0 12)
    (app (repeat 0 10)
         (sched-ifib-loop i))))

; [4] Test the program and your scheduler.

(defun test-ifib (i)
  (top
   (stack
    (run (sched-ifib i)
         (make-state 0
                     ; i = i, j = 1, k = 1, temp = 1
                     (cons i (cons 1 (cons 1 (cons 1 nil))))
                     nil
                     *ifib-program*)))))

(defthm test-ifib-examples
  (and (equal (test-ifib 0) (fib 0))
       (equal (test-ifib 1) (fib 1))
       (equal (test-ifib 2) (fib 2))
       (equal (test-ifib 5) (fib 5))
       (equal (test-ifib 10) (fib 10))
       (equal (test-ifib 20) (fib 20)))
  :rule-classes nil)

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

; Notes about ifib-loop-lemma:

; 1. Because the value of temp is the same as the value of j during each
; iteration of the loop, and because temp is written to before it is read, we
; use j in place of temp in the following theorems.

; 2. Our conclusion is about i, j, k, and temp; therefore our induction
; hypothesis is about the "smaller" values of these variables - namely i - 1, 
; k, j + k, k.

; 3. When ifib is called in the right-hand side of the equality (in the
; theorem's conclusion), we do not know that i > 0; therefore we consider a
; special case when i = 0. When ifib is called with i = 0, the values of j, k,
; and temp are unchanged, so we just return them.

; 4. For the proof to succeed, we must tell ACL2 to induct on ifib. This is
; done using :hints (see :doc hints.)

(defthm ifib-loop-lemma
  (implies (and (natp i)
                (natp j)
                (natp k))
           (equal (run (sched-ifib-loop i)
                       (make-state 13
                                   (cons i (cons j (cons k (cons j nil))))
                                   stack
                                   *ifib-program*))
                  (if (zp i)
                      (make-state 31
                                  (cons i
                                        (cons j
                                              (cons k
                                                    (cons j nil))))
                                  (push k stack)
                                  *ifib-program*)
                    (make-state 31
                              (cons 1
                                    (cons (ifib (- i 1) j k)
                                          (cons (ifib i j k)
                                                (cons (ifib (- i 1) j k)
                                                      nil))))
                              (push (ifib i j k) stack)
                              *ifib-program*))))
  :hints (("Goal"
           :induct (ifib i j k))))

; After proving ifib-loop-lemma, we know that if we start in state where pc =
; 13, and i, j, k are temporary nats, and we run *ifib-program* according to
; sched-ifib-loop, we end up in a state where pc = 31, and one of two things is
; true:
; 1) i was 0, so i, j, k, temp = 0, 1, 1, 1, and k (1) is on the stack;
; 2) i was not 0, so i = 1, j = temp = (ifib i-1 j k), k = (ifib i j k), and
; (ifib i j k) is on the stack.

; Now we will prove that if we start in a state where pc = 0, and i, j, k, temp
; are arbitrary natural numbers, and we run *ifib-program* according to
; sched-ifib, we end up in a state where one of two things is true:
; 1) i was 0, so pc = 11, i, j, k, temp = 0, 1, 1, 1, and j (1) is on the
; stack;
; 2) i was not 0, so pc = 31, i = 1, j = temp = (ifib i-1 1 1), k = (ifib i 1
; 1), and 2) (ifib i 1 1) is on the stack.

(defthm ifib-lemma
  (implies (and (natp i)
                (natp j)
                (natp k))
           (equal (run (sched-ifib i)
                       (make-state 0  ; j = temp at every iteration
                                   (cons i (cons j (cons k (cons j nil))))
                                   stack
                                   *ifib-program*))
                  (if (zp i)
                      (make-state 11
                                  (cons 0 (cons 1 (cons 1 (cons 1 nil))))
                                  (push 1 stack)
                                  *ifib-program*)
                    (make-state 31
                                (cons 1
                                      (cons (ifib (- i 1) 1 1)
                                            (cons (ifib i 1 1)
                                                    (cons (ifib (- i 1) 1 1)
                                                          nil))))
                                (push (ifib i 1 1) stack)
                                *ifib-program*)))))

; We can now disable sched-ifib so that we never run the bytecode again in
; proofs.

(in-theory (disable sched-ifib))

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

; We will show that (ifib i 1 1) = (fib i).

(defthm ifib-fib-lemma
  (implies (and (natp i)
                (natp j)
                (natp k)
                (<= 2 i))
           (equal (ifib i j k)
                  (+ (* (fib (- i 2)) j)
                     (* (fib (- i 1)) k))))
  :hints (("Subgoal *1/6''" :expand (ifib 2 j k))))

(defthm ifib-is-fib
  (implies (natp i)
           (equal (ifib i 1 1)
                  (fib i))))

; [7]  Put it all together.

(defthm ifib-correct
  (implies (and (natp i)
                (natp j)
                (natp k))
           (equal (run (sched-ifib i)
                       (make-state 0  ; j = temp at every iteration
                                   (cons i (cons j (cons k (cons j nil))))
                                   stack
                                   *ifib-program*))
                  (if (zp i)
                      (make-state 11
                                  (cons 0 (cons 1 (cons 1 (cons 1 nil))))
                                  (push 1 stack)
                                  *ifib-program*)
                    (make-state 31
                                (cons 1
                                      (cons (fib (- i 1))
                                            (cons (fib i)
                                                    (cons (fib (- i 1))
                                                          nil))))
                                (push (fib i) stack)
                                *ifib-program*)))))

; After running *ifib-program*, (fib i) is on top of the stack
(defthm ifib-correct-corollary-1
  (implies (and (natp i)
                (natp j)
                (natp k))
           (equal (top
                   (stack
                    (run (sched-ifib i)
                         (make-state 0  ; j = temp at every iteration
                                     (cons i (cons j (cons k (cons j nil))))
                                     stack
                                     *ifib-program*))))
                  (fib i))))

; As above, but with *ifib-program* replaced with the actual code
(defthm ifib-correct-corollary-2
  (implies (and (natp i)
                (natp j)
                (natp k))
           (equal (top
                   (stack
                    (run (sched-ifib i)
                         (make-state 0  ; j = temp at every iteration
                                     (cons i (cons j (cons k (cons j nil))))
                                     stack
                                     (compile
                                      '(i)
                                      '((j = 1)
                                        (k = 1)
                                        (temp = 1)
                                        (if (i = 0)
                                          ((return j))
                                          ((while (i > 1)
                                            (temp = k)
                                            (k = (j + k))
                                            (j = temp)
                                            (i = (i - 1)))
                                           (return k)))))))))
                  (fib i))))