Waverly% v41
Welcome to Clozure Common Lisp Version 1.6-dev-r14316M-trunk  (DarwinX8632)!

 ACL2 Version 4.1 built October 1, 2010  14:31:52.
 Copyright (C) 2010  University of Texas at Austin
 ACL2 comes with ABSOLUTELY NO WARRANTY.  This is free software and you
 are welcome to redistribute it under certain conditions.  For details,
 see the GNU General Public License.

 Initialized with (INITIALIZE-ACL2 'INCLUDE-BOOK *ACL2-PASS-2-FILES*).
 See the documentation topic note-4-1 for recent changes.
 Note: We have modified the prompt in some underlying Lisps to further
 distinguish it from the ACL2 prompt.

ACL2 Version 4.1.  Level 1.  Cbd "/Users/moore/".
Distributed books directory "/Users/moore/work/v4-1/acl2-sources/books/".
Type :help for help.
Type (good-bye) to quit completely out of ACL2.

ACL2 !>(ld "/v/filer4b/v11q001/text/acl2-work-01/reset-margins-for-demo.lisp")

ACL2 Version 4.1.  Level 2.  Cbd "/v/filer4b/v11q001/text/acl2-work-01/".
Distributed books directory "/Users/moore/work/v4-1/acl2-sources/books/".
Type :help for help.
Type (good-bye) to quit completely out of ACL2.

ACL2 !>> "ACL2"
ACL2 !>><state>
ACL2 !>><state>
ACL2 !>> (:WARN! . :OVERWRITE)
ACL2 !>>
TTAG NOTE: Adding ttag SHORT-MARGINS from the top level loop.
 SHORT-MARGINS
ACL2 !>>
ACL2 Warning [Redef] in ( DEFCONST *PROOF-FAILURE-STRING*
...):  *PROOF-FAILURE-STRING* redefined.



Summary
Form:  ( DEFCONST *PROOF-FAILURE-STRING* ...)
Rules: NIL
Warnings:  Redef
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 *PROOF-FAILURE-STRING*
ACL2 !>> (:QUERY . :OVERWRITE)
ACL2 !>>
Summary
Form:  ( RESET-PREHISTORY NIL)
Rules: NIL
Time:  0.03 seconds (prove: 0.00, print: 0.00, other: 0.03)
 :NEW-PREHISTORY-SET
ACL2 !>>Bye.
 :EOF
ACL2 !>(include-book "/u/moore/courses/cs378/jvm/spring-11/m1-lemmas")

To turn on non-linear arithmetic, execute :

(SET-DEFAULT-HINTS
     '((NONLINEARP-DEFAULT-HINT STABLE-UNDER-SIMPLIFICATIONP
                                HIST PSPV)))

or :

(SET-DEFAULT-HINTS
     '((NONLINEARP-DEFAULT-HINT++
            ID
            STABLE-UNDER-SIMPLIFICATIONP HIST NIL)))

See the README for more about non-linear arithmetic
and general information about using this library.



Summary
Form:  ( INCLUDE-BOOK 
"/u/moore/courses/cs378/jvm/spring-11/m1-lemmas" ...)
Rules: NIL
Time:  0.40 seconds (prove: 0.00, print: 0.00, other: 0.40)
 "/Users/moore/courses/cs378/jvm/spring-11/m1-lemmas.lisp"
ACL2 !>(in-package "M1")
 "M1"
M1 !>(pe 'run)
   d      1:x(INCLUDE-BOOK
              "/u/moore/courses/cs378/jvm/spring-11/m1-lemmas")
             \
             [Included books, outermost to innermost:
              "/Users/moore/courses/cs378/jvm/spring-11/m1-lemmas.lisp"
              "/Users/moore/courses/cs378/jvm/spring-11/m1.lisp"
             ]
             \
>L d          (DEFUN RUN (SCHED S)
                     (IF (ENDP SCHED)
                         S (RUN (CDR SCHED) (STEP S))))
M1 !>(defconst *g*
       '((ICONST 1) ;;;  0
         (ISTORE 1) ;;;  1 (a := 1)
         (ILOAD 0)  ;;;  2 (while         ; loop: pc=2
         (IFEQ 10)  ;;;  3   (n != 0)
         (ILOAD 0)  ;;;  4
         (ILOAD 1)  ;;;  5
         (IMUL)     ;;;  6
         (ISTORE 1) ;;;  7   (a := (n * a))
         (ILOAD 0)  ;;;  8
         (ICONST 1) ;;;  9
         (ISUB)     ;;; 10
         (ISTORE 0) ;;; 11   (n := (n - 1))
         (GOTO -10) ;;; 12   )            ; jump to loop
         (ILOAD 1)  ;;; 13
         (HALT)     ;;; 14  (``return'' a)
         ))

Summary
Form:  ( DEFCONST *G* ...)
Rules: NIL
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 *G*
M1 !>(defun g-loop-sched (n)
       (if (zp n)
           (repeat 'tick 3)
           (ap (repeat 'tick 11)
               (g-loop-sched (- n 1)))))

The admission of G-LOOP-SCHED is trivial, using the
relation O< (which is known to be well-founded on the
domain recognized by O-P) and the measure (ACL2-COUNT N).
We observe that the type of G-LOOP-SCHED is described
by the theorem 
(OR (CONSP (G-LOOP-SCHED N)) (EQUAL (G-LOOP-SCHED N) NIL)).
We used the :type-prescription rules AP and REPEAT.

Summary
Form:  ( DEFUN G-LOOP-SCHED ...)
Rules: ((:TYPE-PRESCRIPTION AP)
        (:TYPE-PRESCRIPTION REPEAT))
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 G-LOOP-SCHED
M1 !>(defun g-sched (n)
       (ap (repeat 'tick 2)
           (g-loop-sched n)))

Since G-SCHED is non-recursive, its admission is trivial.
We observe that the type of G-SCHED is described by
the theorem 
(OR (CONSP (G-SCHED N)) (EQUAL (G-SCHED N) NIL)).  We
used the :type-prescription rules AP and G-LOOP-SCHED.

Summary
Form:  ( DEFUN G-SCHED ...)
Rules: ((:TYPE-PRESCRIPTION AP)
        (:TYPE-PRESCRIPTION G-LOOP-SCHED))
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 G-SCHED
M1 !>(g-sched 5)
(TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK
      TICK TICK TICK TICK TICK TICK TICK TICK)
M1 !>(defun test-g (n)
       (top
        (stack
         (run (g-sched n)
              (make-state 0          ; pc
                          (list n 0) ; locals n and a
                          nil        ; stack
                          *g*)       ; code
              ))))

Since TEST-G is non-recursive, its admission is trivial.
We could deduce no constraints on the type of TEST-G.

Summary
Form:  ( DEFUN TEST-G ...)
Rules: NIL
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 TEST-G
M1 !>(test-g 5)
120
M1 !>(test-g 6)
720
M1 !>(test-g 10)
3628800
M1 !>(test-g 100)
93326215443944152681699238856266700490715968264381621468592963895217599993229915608941463976156518286253697920827223758251185210916864000000000000000000000000
M1 !>(test-g 1000)
402387260077093773543702433923003985719374864210714632543799910429938512398629020592044208486969404800479988610197196058631666872994808558901323829669944590997424504087073759918823627727188732519779505950995276120874975462497043601418278094646496291056393887437886487337119181045825783647849977012476632889835955735432513185323958463075557409114262417474349347553428646576611667797396668820291207379143853719588249808126867838374559731746136085379534524221586593201928090878297308431392844403281231558611036976801357304216168747609675871348312025478589320767169132448426236131412508780208000261683151027341827977704784635868170164365024153691398281264810213092761244896359928705114964975419909342221566832572080821333186116811553615836546984046708975602900950537616475847728421889679646244945160765353408198901385442487984959953319101723355556602139450399736280750137837615307127761926849034352625200015888535147331611702103968175921510907788019393178114194545257223865541461062892187960223838971476088506276862967146674697562911234082439208160153780889893964518263243671616762179168909779911903754031274622289988005195444414282012187361745992642956581746628302955570299024324153181617210465832036786906117260158783520751516284225540265170483304226143974286933061690897968482590125458327168226458066526769958652682272807075781391858178889652208164348344825993266043367660176999612831860788386150279465955131156552036093988180612138558600301435694527224206344631797460594682573103790084024432438465657245014402821885252470935190620929023136493273497565513958720559654228749774011413346962715422845862377387538230483865688976461927383814900140767310446640259899490222221765904339901886018566526485061799702356193897017860040811889729918311021171229845901641921068884387121855646124960798722908519296819372388642614839657382291123125024186649353143970137428531926649875337218940694281434118520158014123344828015051399694290153483077644569099073152433278288269864602789864321139083506217095002597389863554277196742822248757586765752344220207573630569498825087968928162753848863396909959826280956121450994871701244516461260379029309120889086942028510640182154399457156805941872748998094254742173582401063677404595741785160829230135358081840096996372524230560855903700624271243416909004153690105933983835777939410970027753472000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
M1 !>(quote (end of demo 1))
(END OF DEMO 1)
M1 !>(thm
      (implies (and (natp n)
                    (natp a))
               (equal (run (repeat 'tick 9)
                           (make-state 4
                                       (list n a)
                                       stk
                                       *g*))
                      ???)))

By the simple :definition NATP, the :executable-counterpart
of REPEAT and the simple :rewrite rule RUN-OPENER we
reduce the conjecture to

Goal'
(IMPLIES
 (AND (INTEGERP N)
      (<= 0 N)
      (INTEGERP A)
      (<= 0 A))
 (EQUAL
  (STEP
   (STEP
    (STEP
     (STEP
      (STEP
       (STEP
           (STEP (STEP (STEP (MAKE-STATE 4 (LIST N A)
                                         STK
                                         '((ICONST 1)
                                           (ISTORE 1)
                                           (ILOAD 0)
                                           (IFEQ 10)
                                           (ILOAD 0)
                                           (ILOAD 1)
                                           (IMUL)
                                           (ISTORE 1)
                                           (ILOAD 0)
                                           (ICONST 1)
                                           (ISUB)
                                           (ISTORE 0)
                                           (GOTO -10)
                                           (ILOAD 1)
                                           (HALT))))))))))))
  ???)).

This simplifies, using the :compound-recognizer rule
ACL2::NATP-COMPOUND-RECOGNIZER, the :definitions DO-INST,
EXECUTE-GOTO, EXECUTE-ICONST, EXECUTE-ILOAD, EXECUTE-IMUL,
EXECUTE-ISTORE, EXECUTE-ISUB, NEXT-INST, NTH and UPDATE-NTH,
the :executable-counterparts of ARG1, ACL2::BINARY-+,
CONSP, EQUAL, NTH, OP-CODE, ACL2::UNARY-- and ZP and
the :rewrite rules ACL2::|(* y x)|, ACL2::|(+ y x)|,
ACL2::CAR-CONS, ACL2::CDR-CONS, NTH-ADD1!, STACKS, STATES
and STEP-OPENER, to

Goal''
(IMPLIES (AND (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (MAKE-STATE 2 (LIST (+ -1 N) (* A N))
                            STK
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT)))
                ???)).

Name the formula above *1.

No induction schemes are suggested by *1.  Consequently,
the proof attempt has failed.

Summary
Form:  ( THM ...)
Rules: ((:COMPOUND-RECOGNIZER
             ACL2::NATP-COMPOUND-RECOGNIZER)
        (:DEFINITION DO-INST)
        (:DEFINITION EXECUTE-GOTO)
        (:DEFINITION EXECUTE-ICONST)
        (:DEFINITION EXECUTE-ILOAD)
        (:DEFINITION EXECUTE-IMUL)
        (:DEFINITION EXECUTE-ISTORE)
        (:DEFINITION EXECUTE-ISUB)
        (:DEFINITION NATP)
        (:DEFINITION NEXT-INST)
        (:DEFINITION NTH)
        (:DEFINITION UPDATE-NTH)
        (:EXECUTABLE-COUNTERPART ARG1)
        (:EXECUTABLE-COUNTERPART ACL2::BINARY-+)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART NTH)
        (:EXECUTABLE-COUNTERPART OP-CODE)
        (:EXECUTABLE-COUNTERPART REPEAT)
        (:EXECUTABLE-COUNTERPART ACL2::UNARY--)
        (:EXECUTABLE-COUNTERPART ZP)
        (:REWRITE ACL2::|(* y x)|)
        (:REWRITE ACL2::|(+ y x)|)
        (:REWRITE ACL2::CAR-CONS)
        (:REWRITE ACL2::CDR-CONS)
        (:REWRITE NTH-ADD1!)
        (:REWRITE RUN-OPENER)
        (:REWRITE STACKS)
        (:REWRITE STATES)
        (:REWRITE STEP-OPENER))
Time:  0.01 seconds (prove: 0.01, print: 0.00, other: 0.00)

---
The key checkpoint goal, below, may help you to debug
this failure.  See :DOC failure and see :DOC set-checkpoint-
summary-limit.
---

*** Key checkpoint at the top level: ***

Goal''
(IMPLIES (AND (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (MAKE-STATE 2 (LIST (+ -1 N) (* A N))
                            STK
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT)))
                ???))

ACL2 Error in ( THM ...):  See :DOC failure.

****************    FAILED    ****************
M1 !>(quote (end of demo 2))
(END OF DEMO 2)
M1 !>(thm
      (equal (run (ap a b) s)
             (run b (run a s)))

; The library we loaded already includes this theorem, so
; of course we can prove it now.  But the text below puts
; ACL2 in the configuration it was in just after RUN was
; defined.  So we'll see its original proof.

 :hints (("Goal" :in-theory (acl2::universal-theory 'run))))

[Note:  A hint was supplied for our processing of the
goal above.  Thanks!]

ACL2 Warning [Disable] in ( THM ...):  IMMEDIATE-FORCE-
MODEP has transitioned from disabled to enabled.
See :DOC immediate-force-modep.


Name the formula above *1.

Perhaps we can prove *1 by induction.  Three induction
schemes are suggested by this conjecture.  These merge
into two derived induction schemes.  However, one of
these is flawed and so we are left with one viable candidate.

We will induct according to a scheme suggested by (RUN A S),
but modified to accommodate (AP A B).  These suggestions
were produced using the :induction rules AP and RUN.
If we let (:P A B S) denote *1 above then the induction
scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP A))
                   (:P (CDR A) B (STEP S)))
              (:P A B S))
     (IMPLIES (ENDP A) (:P A B S))).
This induction is justified by the same argument used
to admit RUN.  Note, however, that the unmeasured variable
S is being instantiated.  When applied to the goal at
hand the above induction scheme produces two nontautological
subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP A))
              (EQUAL (RUN (AP (CDR A) B) (STEP S))
                     (RUN B (RUN (CDR A) (STEP S)))))
         (EQUAL (RUN (AP A B) S)
                (RUN B (RUN A S)))).

By the simple :definition ENDP we reduce the conjecture
to

Subgoal *1/2'
(IMPLIES (AND (CONSP A)
              (EQUAL (RUN (AP (CDR A) B) (STEP S))
                     (RUN B (RUN (CDR A) (STEP S)))))
         (EQUAL (RUN (AP A B) S)
                (RUN B (RUN A S)))).

But simplification reduces this to T, using the :definitions
AP, ARG1, DO-INST, EXECUTE-GOTO, EXECUTE-IADD, 
EXECUTE-ICONST, EXECUTE-IFEQ, EXECUTE-ILOAD, EXECUTE-IMUL,
EXECUTE-ISTORE, EXECUTE-ISUB, LOCALS, MAKE-STATE, NEXT-INST,
NTH, OP-CODE, PC, POP, PROGRAM, PUSH, RUN, STACK, STEP
and TOP, the :executable-counterparts of EQUAL and ZP,
primitive type reasoning and the :rewrite rules 
ACL2::CDR-CONS, ACL2::COMMUTATIVITY-OF-* and 
ACL2::COMMUTATIVITY-OF-+.

Subgoal *1/1
(IMPLIES (ENDP A)
         (EQUAL (RUN (AP A B) S)
                (RUN B (RUN A S)))).

By the simple :definition ENDP we reduce the conjecture
to

Subgoal *1/1'
(IMPLIES (NOT (CONSP A))
         (EQUAL (RUN (AP A B) S)
                (RUN B (RUN A S)))).

But simplification reduces this to T, using the :definitions
AP and RUN and primitive type reasoning.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( THM ...)
Rules: ((:DEFINITION AP)
        (:DEFINITION ARG1)
        (:DEFINITION DO-INST)
        (:DEFINITION ENDP)
        (:DEFINITION EXECUTE-GOTO)
        (:DEFINITION EXECUTE-IADD)
        (:DEFINITION EXECUTE-ICONST)
        (:DEFINITION EXECUTE-IFEQ)
        (:DEFINITION EXECUTE-ILOAD)
        (:DEFINITION EXECUTE-IMUL)
        (:DEFINITION EXECUTE-ISTORE)
        (:DEFINITION EXECUTE-ISUB)
        (:DEFINITION LOCALS)
        (:DEFINITION MAKE-STATE)
        (:DEFINITION NEXT-INST)
        (:DEFINITION NOT)
        (:DEFINITION NTH)
        (:DEFINITION OP-CODE)
        (:DEFINITION PC)
        (:DEFINITION POP)
        (:DEFINITION PROGRAM)
        (:DEFINITION PUSH)
        (:DEFINITION RUN)
        (:DEFINITION STACK)
        (:DEFINITION STEP)
        (:DEFINITION TOP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:INDUCTION AP)
        (:INDUCTION RUN)
        (:REWRITE ACL2::CDR-CONS)
        (:REWRITE ACL2::COMMUTATIVITY-OF-*)
        (:REWRITE ACL2::COMMUTATIVITY-OF-+))
Warnings:  Disable
Time:  0.28 seconds (prove: 0.27, print: 0.00, other: 0.00)

Proof succeeded.
M1 !>(quote (end of demo 3))
(END OF DEMO 3)
M1 !>(defun g (n a)     ; *** The ALGORITHM ***
       (if (zp n)
           a
           (g (- n 1) (* n a))))

The admission of G is trivial, using the relation O<
(which is known to be well-founded on the domain recognized
by O-P) and the measure (ACL2-COUNT N).  We observe
that the type of G is described by the theorem 
(OR (ACL2::ACL2-NUMBERP (G N A)) (EQUAL (G N A) A)).
We used primitive type reasoning.

Summary
Form:  ( DEFUN G ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 G
M1 !>(defthm step-1-loop      ; *** CODE (from loop)
       (implies (and (natp n) ;     implements ALGORITHM ***
                     (natp a))
                (equal (run (g-loop-sched n)
                            (make-state 2          ; <-- pc=loop
                                        (list n a)
                                        stack
                                        *g*))
                       (make-state 14
                                   (list 0 (g n a))
                                   (push (g n a) stack)
                                   *g*))))

By the simple :definition NATP we reduce the conjecture
to

Goal'
(IMPLIES (AND (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

Name the formula above *1.

Perhaps we can prove *1 by induction.  Three induction
schemes are suggested by this conjecture.  Subsumption
reduces that number to one.  

We will induct according to a scheme suggested by (G N A).
This suggestion was produced using the :induction rules
G and G-LOOP-SCHED.  If we let (:P A N STACK) denote
*1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ZP N))
                   (:P (* N A) (+ -1 N) STACK))
              (:P A N STACK))
     (IMPLIES (ZP N) (:P A N STACK))).
This induction is justified by the same argument used
to admit G.  Note, however, that the unmeasured variable
A is being instantiated.  When applied to the goal at
hand the above induction scheme produces six nontautological
subgoals.

Subgoal *1/6
(IMPLIES
   (AND (NOT (ZP N))
        (EQUAL (RUN (G-LOOP-SCHED (+ -1 N))
                    (MAKE-STATE 2 (LIST (+ -1 N) (* N A))
                                STACK
                                '((ICONST 1)
                                  (ISTORE 1)
                                  (ILOAD 0)
                                  (IFEQ 10)
                                  (ILOAD 0)
                                  (ILOAD 1)
                                  (IMUL)
                                  (ISTORE 1)
                                  (ILOAD 0)
                                  (ICONST 1)
                                  (ISUB)
                                  (ISTORE 0)
                                  (GOTO -10)
                                  (ILOAD 1)
                                  (HALT))))
               (MAKE-STATE 14 (LIST 0 (G (+ -1 N) (* N A)))
                           (PUSH (G (+ -1 N) (* N A)) STACK)
                           '((ICONST 1)
                             (ISTORE 1)
                             (ILOAD 0)
                             (IFEQ 10)
                             (ILOAD 0)
                             (ILOAD 1)
                             (IMUL)
                             (ISTORE 1)
                             (ILOAD 0)
                             (ICONST 1)
                             (ISUB)
                             (ISTORE 0)
                             (GOTO -10)
                             (ILOAD 1)
                             (HALT))))
        (INTEGERP N)
        (<= 0 N)
        (INTEGERP A)
        (<= 0 A))
   (EQUAL (RUN (G-LOOP-SCHED N)
               (MAKE-STATE 2 (LIST N A)
                           STACK
                           '((ICONST 1)
                             (ISTORE 1)
                             (ILOAD 0)
                             (IFEQ 10)
                             (ILOAD 0)
                             (ILOAD 1)
                             (IMUL)
                             (ISTORE 1)
                             (ILOAD 0)
                             (ICONST 1)
                             (ISUB)
                             (ISTORE 0)
                             (GOTO -10)
                             (ILOAD 1)
                             (HALT))))
          (MAKE-STATE 14 (LIST 0 (G N A))
                      (PUSH (G N A) STACK)
                      '((ICONST 1)
                        (ISTORE 1)
                        (ILOAD 0)
                        (IFEQ 10)
                        (ILOAD 0)
                        (ILOAD 1)
                        (IMUL)
                        (ISTORE 1)
                        (ILOAD 0)
                        (ICONST 1)
                        (ISUB)
                        (ISTORE 0)
                        (GOTO -10)
                        (ILOAD 1)
                        (HALT))))).

But simplification reduces this to T, using the :compound-
recognizer rules ACL2::NATP-COMPOUND-RECOGNIZER and
ACL2::ZP-COMPOUND-RECOGNIZER, the :definitions AP, DO-INST,
EXECUTE-GOTO, EXECUTE-ICONST, EXECUTE-IFEQ, EXECUTE-ILOAD,
EXECUTE-IMUL, EXECUTE-ISTORE, EXECUTE-ISUB, G, G-LOOP-SCHED,
NEXT-INST, NTH, ACL2::SYNP and UPDATE-NTH, the :executable-
counterparts of ARG1, ACL2::BINARY-+, CAR, CDR, CONSP,
EQUAL, NTH, OP-CODE, REPEAT, ACL2::UNARY-- and ZP, primitive
type reasoning and the :rewrite rules ACL2::|(* y x)|,
ACL2::|(+ y x)|, ACL2::CAR-CONS, ACL2::CDR-CONS, NTH-ADD1!,
ACL2::REMOVE-WEAK-INEQUALITIES, RUN-OPENER, STACKS,
STATES and STEP-OPENER.

Subgoal *1/5
(IMPLIES (AND (NOT (ZP N))
              (< (* N A) 0)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/4
(IMPLIES (AND (NOT (ZP N))
              (NOT (INTEGERP (* N A)))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/3
(IMPLIES (AND (NOT (ZP N))
              (< (+ -1 N) 0)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/2
(IMPLIES (AND (NOT (ZP N))
              (NOT (INTEGERP (+ -1 N)))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/1
(IMPLIES (AND (ZP N)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (MAKE-STATE 2 (LIST N A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G N A))
                            (PUSH (G N A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

This simplifies, using the :compound-recognizer rule
ACL2::ZP-COMPOUND-RECOGNIZER, the :executable-counterparts
of <, G-LOOP-SCHED, INTEGERP, NOT and ZP and linear
arithmetic, to

Subgoal *1/1'
(IMPLIES (AND (INTEGERP A) (<= 0 A))
         (EQUAL (RUN '(TICK TICK TICK)
                     (MAKE-STATE 2 (LIST 0 A)
                                 STACK
                                 '((ICONST 1)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (IFEQ 10)
                                   (ILOAD 0)
                                   (ILOAD 1)
                                   (IMUL)
                                   (ISTORE 1)
                                   (ILOAD 0)
                                   (ICONST 1)
                                   (ISUB)
                                   (ISTORE 0)
                                   (GOTO -10)
                                   (ILOAD 1)
                                   (HALT))))
                (MAKE-STATE 14 (LIST 0 (G 0 A))
                            (PUSH (G 0 A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

By the simple :rewrite rule RUN-OPENER we reduce the
conjecture to

Subgoal *1/1''
(IMPLIES (AND (INTEGERP A) (<= 0 A))
         (EQUAL (STEP (STEP (STEP (MAKE-STATE 2 (LIST 0 A)
                                              STACK
                                              '((ICONST 1)
                                                (ISTORE 1)
                                                (ILOAD 0)
                                                (IFEQ 10)
                                                (ILOAD 0)
                                                (ILOAD 1)
                                                (IMUL)
                                                (ISTORE 1)
                                                (ILOAD 0)
                                                (ICONST 1)
                                                (ISUB)
                                                (ISTORE 0)
                                                (GOTO -10)
                                                (ILOAD 1)
                                                (HALT))))))
                (MAKE-STATE 14 (LIST 0 (G 0 A))
                            (PUSH (G 0 A) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But simplification reduces this to T, using the :compound-
recognizer rule ACL2::NATP-COMPOUND-RECOGNIZER, the
:definitions DO-INST, EXECUTE-IFEQ, EXECUTE-ILOAD, G,
NEXT-INST and NTH, the :executable-counterparts of ARG1,
ACL2::BINARY-+, CONSP, EQUAL, NTH, OP-CODE and ZP, primitive
type reasoning and the :rewrite rules ACL2::CAR-CONS,
ACL2::CDR-CONS, NTH-ADD1!, STACKS, STATES and STEP-OPENER.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM STEP-1-LOOP ...)
Rules: ((:COMPOUND-RECOGNIZER
             ACL2::NATP-COMPOUND-RECOGNIZER)
        (:COMPOUND-RECOGNIZER ACL2::ZP-COMPOUND-RECOGNIZER)
        (:DEFINITION AP)
        (:DEFINITION DO-INST)
        (:DEFINITION EXECUTE-GOTO)
        (:DEFINITION EXECUTE-ICONST)
        (:DEFINITION EXECUTE-IFEQ)
        (:DEFINITION EXECUTE-ILOAD)
        (:DEFINITION EXECUTE-IMUL)
        (:DEFINITION EXECUTE-ISTORE)
        (:DEFINITION EXECUTE-ISUB)
        (:DEFINITION G)
        (:DEFINITION G-LOOP-SCHED)
        (:DEFINITION NATP)
        (:DEFINITION NEXT-INST)
        (:DEFINITION NOT)
        (:DEFINITION NTH)
        (:DEFINITION ACL2::SYNP)
        (:DEFINITION UPDATE-NTH)
        (:EXECUTABLE-COUNTERPART <)
        (:EXECUTABLE-COUNTERPART ARG1)
        (:EXECUTABLE-COUNTERPART ACL2::BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART G-LOOP-SCHED)
        (:EXECUTABLE-COUNTERPART INTEGERP)
        (:EXECUTABLE-COUNTERPART NOT)
        (:EXECUTABLE-COUNTERPART NTH)
        (:EXECUTABLE-COUNTERPART OP-CODE)
        (:EXECUTABLE-COUNTERPART REPEAT)
        (:EXECUTABLE-COUNTERPART ACL2::UNARY--)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:INDUCTION G)
        (:INDUCTION G-LOOP-SCHED)
        (:REWRITE ACL2::|(* y x)|)
        (:REWRITE ACL2::|(+ y x)|)
        (:REWRITE ACL2::CAR-CONS)
        (:REWRITE ACL2::CDR-CONS)
        (:REWRITE NTH-ADD1!)
        (:REWRITE ACL2::REMOVE-WEAK-INEQUALITIES)
        (:REWRITE RUN-OPENER)
        (:REWRITE STACKS)
        (:REWRITE STATES)
        (:REWRITE STEP-OPENER))
Time:  0.04 seconds (prove: 0.01, print: 0.03, other: 0.00)
 STEP-1-LOOP
M1 !>(defthm step-1-top       ; *** CODE (from top)
            (implies (natp n) ;     implements ALGORITHM ***
                (equal (run (g-sched n)
                            (make-state 0         ; <-- pc=top
                                        (list n a)
                                        stack
                                        *g*))
                       (make-state 14
                                   (list 0 (g n 1))
                                   (push (g n 1) stack)
                                   *g*))))

ACL2 Warning [Non-rec] in ( DEFTHM STEP-1-TOP ...):
A :REWRITE rule generated from STEP-1-TOP will be triggered
only by terms containing the non-recursive function
symbol G-SCHED.  Unless this function is disabled, this
rule is unlikely ever to be used.


By the simple :definitions G-SCHED and NATP, the :executable-
counterpart of REPEAT and the simple :rewrite rules
RUN-AP and RUN-OPENER we reduce the conjecture to

Goal'
(IMPLIES (AND (INTEGERP N) (<= 0 N))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (STEP (STEP (MAKE-STATE 0 (LIST N A)
                                             STACK
                                             '((ICONST 1)
                                               (ISTORE 1)
                                               (ILOAD 0)
                                               (IFEQ 10)
                                               (ILOAD 0)
                                               (ILOAD 1)
                                               (IMUL)
                                               (ISTORE 1)
                                               (ILOAD 0)
                                               (ICONST 1)
                                               (ISUB)
                                               (ISTORE 0)
                                               (GOTO -10)
                                               (ILOAD 1)
                                               (HALT))))))
                (MAKE-STATE 14 (LIST 0 (G N 1))
                            (PUSH (G N 1) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But simplification reduces this to T, using the :compound-
recognizer rule ACL2::NATP-COMPOUND-RECOGNIZER, the
:definitions DO-INST, EXECUTE-ICONST, EXECUTE-ISTORE,
NEXT-INST and UPDATE-NTH, the :executable-counterparts
of ARG1, ACL2::BINARY-+, CONS, CONSP, EQUAL, NTH, OP-CODE
and ZP, primitive type reasoning and the :rewrite rules
ACL2::CAR-CONS, ACL2::CDR-CONS, STACKS, STATES, STEP-1-LOOP
and STEP-OPENER.

Q.E.D.

Summary
Form:  ( DEFTHM STEP-1-TOP ...)
Rules: ((:COMPOUND-RECOGNIZER
             ACL2::NATP-COMPOUND-RECOGNIZER)
        (:DEFINITION DO-INST)
        (:DEFINITION EXECUTE-ICONST)
        (:DEFINITION EXECUTE-ISTORE)
        (:DEFINITION G-SCHED)
        (:DEFINITION NATP)
        (:DEFINITION NEXT-INST)
        (:DEFINITION UPDATE-NTH)
        (:EXECUTABLE-COUNTERPART ARG1)
        (:EXECUTABLE-COUNTERPART ACL2::BINARY-+)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART NTH)
        (:EXECUTABLE-COUNTERPART OP-CODE)
        (:EXECUTABLE-COUNTERPART REPEAT)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE ACL2::CAR-CONS)
        (:REWRITE ACL2::CDR-CONS)
        (:REWRITE RUN-AP)
        (:REWRITE RUN-OPENER)
        (:REWRITE STACKS)
        (:REWRITE STATES)
        (:REWRITE STEP-1-LOOP)
        (:REWRITE STEP-OPENER))
Warnings:  Non-rec
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.00)
 STEP-1-TOP
M1 !>(defun ! (n)        ; *** the SPECIFICATION ***
       (if (zp n)
           1
           (* n (! (- n 1)))))

The admission of ! is trivial, using the relation O<
(which is known to be well-founded on the domain recognized
by O-P) and the measure (ACL2-COUNT N).  We observe
that the type of ! is described by the theorem 
(AND (INTEGERP (! N)) (< 0 (! N))).  We used the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Summary
Form:  ( DEFUN ! ...)
Rules: ((:COMPOUND-RECOGNIZER ACL2::ZP-COMPOUND-RECOGNIZER)
        (:FAKE-RUNE-FOR-TYPE-SET NIL))
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 !
M1 !>(defthm step-2           ; *** ALGORITHM implements
       (implies (and (natp n) ;      SPECIFICATION ***
                     (natp a))
                (equal (g n a)
                       (* (! n) a))))

By the simple :definition NATP we reduce the conjecture
to

Goal'
(IMPLIES (AND (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* (! N) A))).

This simplifies, using the :rewrite rule ACL2::|(* y x)|,
to

Goal''
(IMPLIES (AND (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

Name the formula above *1.

Perhaps we can prove *1 by induction.  Two induction
schemes are suggested by this conjecture.  Subsumption
reduces that number to one.  

We will induct according to a scheme suggested by (G N A).
This suggestion was produced using the :induction rules
! and G.  If we let (:P A N) denote *1 above then the
induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ZP N)) (:P (* N A) (+ -1 N)))
              (:P A N))
     (IMPLIES (ZP N) (:P A N))).
This induction is justified by the same argument used
to admit G.  Note, however, that the unmeasured variable
A is being instantiated.  When applied to the goal at
hand the above induction scheme produces six nontautological
subgoals.

Subgoal *1/6
(IMPLIES (AND (NOT (ZP N))
              (EQUAL (G (+ -1 N) (* N A))
                     (* (* N A) (! (+ -1 N))))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

By the simple :rewrite rule ACL2::|(* (* x y) z)| we
reduce the conjecture to

Subgoal *1/6'
(IMPLIES (AND (NOT (ZP N))
              (EQUAL (G (+ -1 N) (* N A))
                     (* N A (! (+ -1 N))))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

But simplification reduces this to T, using the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER, the :definition\
s !, G and ACL2::SYNP, primitive type reasoning and
the :rewrite rules ACL2::|(* y (* x z))| and 
ACL2::REMOVE-WEAK-INEQUALITIES.

Subgoal *1/5
(IMPLIES (AND (NOT (ZP N))
              (< (* N A) 0)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/4
(IMPLIES (AND (NOT (ZP N))
              (NOT (INTEGERP (* N A)))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/3
(IMPLIES (AND (NOT (ZP N))
              (< (+ -1 N) 0)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/2
(IMPLIES (AND (NOT (ZP N))
              (NOT (INTEGERP (+ -1 N)))
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

But we reduce the conjecture to T, by the :compound-
recognizer rule ACL2::ZP-COMPOUND-RECOGNIZER and primitive
type reasoning.

Subgoal *1/1
(IMPLIES (AND (ZP N)
              (INTEGERP N)
              (<= 0 N)
              (INTEGERP A)
              (<= 0 A))
         (EQUAL (G N A) (* A (! N)))).

This simplifies, using the :compound-recognizer rule
ACL2::ZP-COMPOUND-RECOGNIZER, the :executable-counterparts
of !, <, INTEGERP, NOT and ZP and linear arithmetic,
to

Subgoal *1/1'
(IMPLIES (AND (INTEGERP A) (<= 0 A))
         (EQUAL (G 0 A) (* A 1))).

But simplification reduces this to T, using the :definition
G, the :executable-counterpart of ZP, primitive type
reasoning and the :rewrite rules ACL2::|(* 1 x)| and
ACL2::|(* y x)|.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM STEP-2 ...)
Rules: ((:COMPOUND-RECOGNIZER ACL2::ZP-COMPOUND-RECOGNIZER)
        (:DEFINITION !)
        (:DEFINITION G)
        (:DEFINITION NATP)
        (:DEFINITION NOT)
        (:DEFINITION ACL2::SYNP)
        (:EXECUTABLE-COUNTERPART !)
        (:EXECUTABLE-COUNTERPART <)
        (:EXECUTABLE-COUNTERPART INTEGERP)
        (:EXECUTABLE-COUNTERPART NOT)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:INDUCTION !)
        (:INDUCTION G)
        (:REWRITE ACL2::|(* (* x y) z)|)
        (:REWRITE ACL2::|(* 1 x)|)
        (:REWRITE ACL2::|(* y (* x z))|)
        (:REWRITE ACL2::|(* y x)|)
        (:REWRITE ACL2::REMOVE-WEAK-INEQUALITIES))
Time:  0.04 seconds (prove: 0.03, print: 0.01, other: 0.00)
 STEP-2
M1 !>(defthm code-is-correct ; *** CODE implements SPECIFICATION ***
       (implies (natp n)
                (equal (run (g-sched n)
                            (make-state 0
                                        (list n a) 
                                        stack
                                        *g*))
                       (make-state 14
                                   (list 0 (! n))
                                   (push (! n) stack)
                                   *g*))))

ACL2 Warning [Non-rec] in ( DEFTHM CODE-IS-CORRECT ...):
A :REWRITE rule generated from CODE-IS-CORRECT will
be triggered only by terms containing the non-recursive
function symbol G-SCHED.  Unless this function is disabled,
this rule is unlikely ever to be used.


ACL2 Warning [Subsume] in ( DEFTHM CODE-IS-CORRECT ...):
A newly proposed :REWRITE rule generated from 
CODE-IS-CORRECT probably subsumes the previously added
:REWRITE rule STEP-1-TOP, in the sense that the new
rule will now probably be applied whenever the old rule
would have been.


ACL2 Warning [Subsume] in ( DEFTHM CODE-IS-CORRECT ...):
The previously added rule STEP-1-TOP subsumes a newly
proposed :REWRITE rule generated from CODE-IS-CORRECT,
in the sense that the old rule rewrites a more general
target.  Because the new rule will be tried first, it
may nonetheless find application.


By the simple :definitions G-SCHED and NATP, the :executable-
counterpart of REPEAT and the simple :rewrite rules
RUN-AP and RUN-OPENER we reduce the conjecture to

Goal'
(IMPLIES (AND (INTEGERP N) (<= 0 N))
         (EQUAL (RUN (G-LOOP-SCHED N)
                     (STEP (STEP (MAKE-STATE 0 (LIST N A)
                                             STACK
                                             '((ICONST 1)
                                               (ISTORE 1)
                                               (ILOAD 0)
                                               (IFEQ 10)
                                               (ILOAD 0)
                                               (ILOAD 1)
                                               (IMUL)
                                               (ISTORE 1)
                                               (ILOAD 0)
                                               (ICONST 1)
                                               (ISUB)
                                               (ISTORE 0)
                                               (GOTO -10)
                                               (ILOAD 1)
                                               (HALT))))))
                (MAKE-STATE 14 (LIST 0 (! N))
                            (PUSH (! N) STACK)
                            '((ICONST 1)
                              (ISTORE 1)
                              (ILOAD 0)
                              (IFEQ 10)
                              (ILOAD 0)
                              (ILOAD 1)
                              (IMUL)
                              (ISTORE 1)
                              (ILOAD 0)
                              (ICONST 1)
                              (ISUB)
                              (ISTORE 0)
                              (GOTO -10)
                              (ILOAD 1)
                              (HALT))))).

But simplification reduces this to T, using the :compound-
recognizer rule ACL2::NATP-COMPOUND-RECOGNIZER, the
:definitions DO-INST, EXECUTE-ICONST, EXECUTE-ISTORE,
NEXT-INST and UPDATE-NTH, the :executable-counterparts
of ARG1, ACL2::BINARY-+, CONS, CONSP, EQUAL, NTH, OP-CODE
and ZP, primitive type reasoning, the :rewrite rules
ACL2::|(* 1 x)|, ACL2::|(* y x)|, ACL2::CAR-CONS, 
ACL2::CDR-CONS, STACKS, STATES, STEP-1-LOOP, STEP-2
and STEP-OPENER and the :type-prescription rule !.

Q.E.D.

Summary
Form:  ( DEFTHM CODE-IS-CORRECT ...)
Rules: ((:COMPOUND-RECOGNIZER
             ACL2::NATP-COMPOUND-RECOGNIZER)
        (:DEFINITION DO-INST)
        (:DEFINITION EXECUTE-ICONST)
        (:DEFINITION EXECUTE-ISTORE)
        (:DEFINITION G-SCHED)
        (:DEFINITION NATP)
        (:DEFINITION NEXT-INST)
        (:DEFINITION UPDATE-NTH)
        (:EXECUTABLE-COUNTERPART ARG1)
        (:EXECUTABLE-COUNTERPART ACL2::BINARY-+)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART NTH)
        (:EXECUTABLE-COUNTERPART OP-CODE)
        (:EXECUTABLE-COUNTERPART REPEAT)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE ACL2::|(* 1 x)|)
        (:REWRITE ACL2::|(* y x)|)
        (:REWRITE ACL2::CAR-CONS)
        (:REWRITE ACL2::CDR-CONS)
        (:REWRITE RUN-AP)
        (:REWRITE RUN-OPENER)
        (:REWRITE STACKS)
        (:REWRITE STATES)
        (:REWRITE STEP-1-LOOP)
        (:REWRITE STEP-2)
        (:REWRITE STEP-OPENER)
        (:TYPE-PRESCRIPTION !))
Warnings:  Subsume and Non-rec
Time:  0.01 seconds (prove: 0.01, print: 0.00, other: 0.00)
 CODE-IS-CORRECT
M1 !>(quote (end of demo 4))
(END OF DEMO 4)
M1 !>