(include-book "m1-with-stobj") (in-package "M1") (set-verify-guards-eagerness 0) ; ----------------------------------------------------------------- ; First I demonstrate that non-termination can be proved by the clock method (defconst *pi* '((ICONST 0) ; 0 (ISTORE 2) ; 1 a \$=\$ 0; (ILOAD 0) ; 2 [loop:] (IFEQ 10) ; 3 if x\$=\$0 then go to end; (ILOAD 0) ; 4 (ICONST 1) ; 5 (ISUB) ; 6 (ISTORE 0) ; 7 x \$=\$ x-1; (ILOAD 1) ; 8 (ILOAD 2) ; 9 (IADD) ;10 (ISTORE 2) ;11 a \$=\$ y+a; (GOTO -10) ;12 go to loop (ILOAD 2) ;13 [end:] (HALT) ;14 ``return'' a )) (defun bad-statep (s) (declare (xargs :stobjs (s))) (and (sp s) (natp (rd :pc s)) (integerp (loi 0 s)) (integerp (loi 1 s)) (integerp (loi 2 s)) (<= 3 (len (rd :locals s))) (< (loi 0 s) 0) (equal (rd :program s) *pi*))) (defun loop-clk (n) (if (zp n) 0 (clk+ 11 (loop-clk (- n 1))))) (defun clk (n) (if (zp n) 0 (if (equal n 1) 1 (clk+ 2 (loop-clk (floor (- n 2) 11)) (mod (- n 2) 11))))) (defun hint (n s) (declare (xargs :stobjs (s))) (if (zp n) s (let ((s (m1 s 11))) (hint (- n 1) s)))) (defthm lemma1 (implies (and (bad-statep s) (equal (rd :pc s) 2) (natp n)) (equal (m1 s (loop-clk n)) (!loi 0 (- (loi 0 s) n) (!loi 2 (+ (* n (loi 1 s)) (loi 2 s)) s)))) :hints (("Goal" :induct (hint n s)))) (in-theory (disable loop-clk)) (include-book "enumerate") (defthm lemma2 (implies (and (bad-statep s) (equal (rd :pc s) 0) (equal sf (m1 s (clk n)))) (not (haltedp sf))) :hints (("Goal" :use (:instance acl2::enumerate (acl2::term (mod n 11)) (acl2::i 0) (acl2::j 10))))) (in-theory (disable clk)) (defthm lemma3 (implies (natp n) (equal (loop-clk n) (* 11 n))) :hints (("Goal" :in-theory (enable loop-clk binary-clk+)))) (defthm lemma4 (implies (natp n) (equal (clk n) n)) :hints (("Goal" :in-theory (enable clk binary-clk+)))) (defthm main (implies (and (bad-statep s) (equal (rd :pc s) 0) (natp n) (equal sf (m1 s n))) (not (haltedp sf))) :hints (("Goal" :use (lemma2)))) (quote (Wormhole Abstraction from Dave Greve)) ; ----------------------------------------------------------------- ; Eventually I want to show wormhole abstraction here, by replacing the (!loi 2 ---) (pe 'lemma1) (ubt! 'lemma1) (defun-nx whatever-it-is (s n) ; value of local 2 after running (loi 2 (m1 s (loop-clk n)))) ; around the loop n times (defthm lemma1 (implies (and (bad-statep s) (equal (rd :pc s) 2) (natp n)) (equal (m1 s (loop-clk n)) (!loi 0 (- (loi 0 s) n) (!loi 2 (whatever-it-is s n) s)))) :hints (("Goal" :induct (hint n s)))) (in-theory (disable whatever-it-is)) (quote (back to talk)) ; ----------------------------------------------------------------- (ubt! '(*pi* 1)) (defun x (s) (declare (xargs :stobjs (s))) (loi 0 s)) (defun y (s) (declare (xargs :stobjs (s))) (loi 1 s)) (defun a (s) (declare (xargs :stobjs (s))) (loi 2 s)) (include-book "m1-with-stobj-defspec") (trans1 '(defspec pi *pi* (x0 y0 a0) 0 14 ((0 ; Pre-condition (and (natp x0) (equal (x s) x0) (equal (y s) y0))) (2 ; Loop Invariant (and (natp x0) (natp (x s)) (<= (x s) x0) (equal (y s) y0) (equal (a s) (* y0 (- x0 (x s)))))) (14 ; Post-condition (equal (top (rd :stack s)) (* x0 y0)))) t)) (defspec pi *pi* (x0 y0 a0) 0 14 ((0 ; Pre-condition (and (natp x0) (equal (x s) x0) (equal (y s) y0))) (2 ; Loop Invariant (and (natp x0) (natp (x s)) (<= (x s) x0) (equal (y s) y0) (equal (a s) (* y0 (- x0 (x s)))))) (14 ; Post-condition (equal (top (rd :stack s)) (* x0 y0)))) t) (pe 'PARTIAL-CORRECTNESS-OF-PROGRAM-PI-RESTATED) (quote (back to talk)) (u) (defspec pi *pi* (x0 y0 a0) 0 14 ((0 ; Pre-condition (and (integerp x0) (equal (x s) x0) (equal (y s) y0))) (2 ; Loop Invariant (and (integerp x0) (integerp (x s)) (<= (x s) x0) (equal (y s) y0) (equal (a s) (* y0 (- x0 (x s)))))) (14 ; Post-condition (and (natp x0) (equal (top (rd :stack s)) (* x0 y0))))) t) (pe 'PARTIAL-CORRECTNESS-OF-PROGRAM-PI-RESTATED) (quote (the end))