#|
(include-book "m1")
(certify-book "m1-lemmas" 1)
|#

(in-package "M1")

; Arithmetic

(include-book "arithmetic-3/extra/top-ext" :dir :system)

; Abstract Data Type Stuff

(defthm stacks
  (and (equal (top (push x s)) x)
       (equal (pop (push x s)) s)

; These next two are needed because some push expressions evaluate to
; list constants, e.g., (push 1 (push 2 nil)) becomes '(1 2) and '(1
; 2) pattern-matches with (cons x s) but not with (push x s).

       (equal (top (cons x s)) x)
       (equal (pop (cons x s)) s)))

(in-theory (disable push top pop))

(defthm states
  (and (equal (pc (make-state pc locals stack program)) pc)
       (equal (locals (make-state pc locals stack program)) locals)
       (equal (stack (make-state pc locals stack program)) stack)
       (equal (program (make-state pc locals stack program)) program)

; And we add the rules to handle constant states:

       (equal (pc (cons pc x)) pc)
       (equal (locals (cons pc (cons locals x))) locals)
       (equal (stack (cons pc (cons locals (cons stack x)))) stack)
       (equal (program (cons pc (cons locals (cons stack (cons program x)))))
              program)))

(in-theory (disable make-state pc locals stack program))

; Dealing with updating LOCALS

(defthm update-nth-opener
  (and (equal (update-nth 0 v lst) (cons v (cdr lst)))
       (implies (not (zp n))
                (equal (update-nth (+ 1 n) v lst)
                       (cons (car lst) (update-nth n v (cdr lst)))))))

; Step Stuff

(defthm step-opener
  (implies (consp (next-inst s))
           (equal (step s)
                  (do-inst (next-inst s) s))))

(in-theory (disable step))

; Run Stuff

(defthm run-app
  (equal (run (app a b) s)
         (run b (run a s))))
  
(defthm run-opener
  (and (equal (run nil s) s)
       (equal (run (cons th sched) s)
              (run sched (step s)))))

(in-theory (disable run))