; practice-midterm-answers.lisp

; Implicitly below I am operating in the following environment:

; (include-book "m1-lemmas")

(in-package "M1")

; Problem 1

; Define the function execute-DUP to extend M1 with the following new instruction

;  Format: (DUP)
;  Stack:  ..., v => ..., v, v
;  Description:
;  Duplicates the topmost item on the stack.

; Note: To actually extend M1 we would have to change do-inst also, but that is
; not necessary here.

; Answer 1:

(defun execute-DUP (inst s)
  (declare (ignore inst))
  (make-state (+ 1 (pc s))
              (locals s)
              (push (top (stack s)) (stack s))
              (program s)))

; Problem 2

; Given

(defun sum (n)
  (if (zp n)
      0
    (+ n (sum (- n 1)))))

(defthm problem-2
  (implies (natp n)
           (equal (sum n) (/ (+ (* n n) n) 2))))

; Answer:

; Just execute the defthm above.

; Problem 3

; Suppose n is a natural number (a nonnegative integer).  Write an M1 program
; that sums the naturals from n down to 0 and halts with the result on top of
; the stack.  Let *prog* be the ACL2 constant that contains your list of
; instructions.  Note: you know that the result of running *prog* will be
; (n^2 + n)/2, but the program should compute it by iterated additions.

; Answer:

(defconst *prog*
  '((iconst 0)
    (istore 1)
    (iload 0)
    (ifle 10)
    (iload 0)
    (iload 1)
    (iadd)
    (istore 1)
    (iload 0)
    (iconst -1)
    (iadd)
    (istore 0)
    (goto -10)
    (iload 1)
    (halt)))

; Problem 4

; Write the schedule function, sched, to drive your program to its HALT
; statement for an arbitrary given natural number n.

; Answer

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

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

; Problem 5
; Write the additional definitions and theorems required to give the
; abbreviated proof of

; (implies (natp n)
;          (equal (top
;                  (stack
;                   (run (sched n)
;                        (make-state 0 (list n a) stack *prog*))))
;                 (/ (+ (* n n) n) 2)))

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

(defthm loop-correct
  (implies (and (natp n)
                (natp a))
           (equal (run (sched-loop n)
                       (make-state 2
                                   (list n a)
                                   stack
                                   *prog*))
                  (make-state 14
                              (list 0 (sum1 n a))
                              (push (sum1 n a) stack)
                              *prog*))))

(defthm prog-correct
  (implies (natp n)
           (equal (run (sched n)
                       (make-state 0
                                   (list n a)
                                   stack
                                   *prog*))
                  (make-state 14
                              (list 0 (sum1 n 0))
                              (push (sum1 n 0) stack)
                              *prog*))))

(in-theory (disable sched))

(defthm sum1-correct
  (implies (and (natp n)
                (natp a))
           (equal (sum1 n a)
                  (+ a (/ (+ (* n n) n) 2)))))

(defthm main
  (implies (natp n)
           (equal (top
                   (stack
                    (run (sched n)
                         (make-state 0 (list n a) stack *prog*))))
                  (/ (+ (* n n) n) 2))))