A Flying Demo of ACL2

Matt Kaufmann and J Strother Moore
Department of Computer Sciences
University of Texas at Austin
Email: kaufmann@cs.utexas.edu and moore@cs.utexas.edu

Abstract

ACL2 is an interactive mechanical theorem prover designed for use in modeling hardware and software and proving properties about those models.

This web page takes you through a series of proofs by ACL2, just to illustrate how it is used.

These are extremely simple applications.

But they are suggestive of much more ambitious ACL2 case studies.

You will not learn how ACL2 ``works'' here.

You will learn how ACL2 is used in industry to model digital artifacts.

[next]

About ACL2

ACL2 stands for ``A Computational Logic for Applicative Common Lisp.'' It is

a functional programming language based on Common Lisp,
a first-order mathematical logic, and
a mechanical theorem prover.

ACL2 was written by Matt Kaufmann and J Strother Moore and is the successor to the Boyer-Moore theorem prover. It has been under continuous development since 1989.

ACL2 can be used to prove theorems about a wide variety of computing applications, including hardware and software in languages other than Lisp.

The ACL2 Home Page contains links to books and papers about ACL2, the source code and installation instructions, an online user's manual, many certified books of definitions and theorems, and other resources.

ACL2 is distributed without fee under the terms of the GNU General Public License.

[top] [prev] [next]


[top] [prev] [next]

The Demo

This demo simulates an interactive session with the ACL2 read-eval-print loop. Colors will be used to distinguish user input, system output, and commentary added for the demo.

We recommend that you navigate by clicking on our links (above), using your navigator's back and forward buttons, or using your navigator's scroll up and scroll down buttons. Navigation with the slide bar is usually confusing. The demo is best if you size your browser's window so that you can see everything on this page from the row of ``top-prev-next'' links above to the row of x's below. The row ends with an exclamation mark; widen your window so you can see it without horizontal scrolling.

ACL2's database is configured to contain some definitions and theorems before the demo begins. The demo does not disclose these details. But the full script for this demo along with all supporting material is available on the Web and you may replay it with your local copy of ACL2.

The first few commands illustrate the navigational aids of the demo as well as ACL2's syntax and style. Then, in rapid succession the demo presents definitions and theorems touching on the following topics:

Introduction
Insertion Sort
Bit Vector Addition and Multiplication
A Simple Netlist Description Language
A Simple Stack Machine and Expression Compiler
The Toy Java Virtual Machine and Byte Code Proofs

The HTML packaging of this demo was prepared using ACL2 Version 2.5. Behavior for other versions of ACL2 may be different.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx!


[top] [prev] [next]

ACL2 Version 2.5.  Level 1.  Cbd "/v/hank/v92/moore/demo/flying-demo/".
Type :help for help.

ACL2 !>

Output by the ACL2 system is printed in black. Commentary added for this demo is in blue. If you click on the [next] link, a command will appear.


[top] [prev] [next]

ACL2 Version 2.5.  Level 1.  Cbd "/v/hank/v92/moore/demo/flying-demo/".
Type :help for help.

ACL2 !>(+ 3 4)

User input is printed in red. If you click on the next link above, ACL2 will print the value of the expression (+ 3 4), i.e., 3+4.


[top] [prev] [next]

ACL2 Version 2.5.  Level 1.  Cbd "/v/hank/v92/moore/demo/flying-demo/".
Type :help for help.

ACL2 !>(+ 3 4)
7
ACL2 !>


[top] [prev] [next]

ACL2 Version 2.5.  Level 1.  Cbd "/v/hank/v92/moore/demo/flying-demo/".
Type :help for help.

ACL2 !>(+ 3 4)
7
ACL2 !>(equal (car (cons 1 '(2 3 4))) 1)

We assume you know enough Lisp to evaluate this expression. What is its value? The function cons constructs an ordered pair of its two arguments. The function car returns the first component of an ordered pair; cdr, not used here, returns the other component. The function equal returns T or NIL (true or false) according to whether its two arguments are the same object.


[top] [prev] [next]

ACL2 Version 2.5.  Level 1.  Cbd "/v/hank/v92/moore/demo/flying-demo/".
Type :help for help.

ACL2 !>(+ 3 4)
7
ACL2 !>(equal (car (cons 1 '(2 3 4))) 1)
T
ACL2 !>


[top] [prev] [next]

ACL2 !>(thm (equal (car (cons x y)) x))

This is a command to prove the indicated theorem. The theorem states that the car of the cons of two things is the first one. If you click on the link you will see ACL2 prove this.


[top] [prev] [next]

ACL2 !>(thm (equal (car (cons x y)) x))

By the simple :rewrite rule CAR-CONS we reduce the conjecture to

Goal'
(EQUAL X X).

But we reduce the conjecture to T, by primitive type reasoning.

Q.E.D.

Summary
Form:  ( THM ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS))
Warnings:  None
Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)

Proof succeeded.
ACL2 !>

As you can see, ACL2's ``proofs'' are really descriptions of proofs or proof sketches, not formal mathematical proofs. But if ACL2 prints the ``Q.E.D.'' then it has confirmed (behind the scenes) that a formal proof exists. ACL2 contains a lot of decision procedures and powerful simplification techniques. So it is not always obvious how the system gets from one goal to the next. Note the time taken to do the proof.


[top] [prev] [next]

ACL2 !>(endp nil)

The function endp recognizes the empty list.


[top] [prev] [next]

ACL2 !>(endp nil)
T
ACL2 !>


[top] [prev] [next]

ACL2 !>(endp nil)
T
ACL2 !>(endp '(1 2 3 4))


[top] [prev] [next]

ACL2 !>(endp nil)
T
ACL2 !>(endp '(1 2 3 4))
NIL
ACL2 !>

NIL is the symbol used by Lisp and ACL2 to denote the ``false'' truthvalue. NIL is also the ``empty list.'' T denotes the ``true'' truthvalue. Case is unimportant here. So nil and NIL are the same thing.


[top] [prev] [next]

ACL2 !>(thm (implies (and (not (endp x))
                          (endp (cdr x))
                          (integerp n)
                          (<= 0 n)
                          (rationalp u))
                     (< (* (len x) u) (+ u n 3))))

Another simple theorem. Think about the proof. Then click on the link and see if you understand ACL2's proof.

When you click, the proof may overflow your browser's window. If so, scroll down to the next command prompt using your browser's scroll buttons. We recommend against using the slide bar!


[top] [prev] [next]

ACL2 !>(thm (implies (and (not (endp x))
                          (endp (cdr x))
                          (integerp n)
                          (<= 0 n)
                          (rationalp u))
                     (< (* (len x) u) (+ u n 3))))

By the simple :definition ENDP we reduce the conjecture to

Goal'
(IMPLIES (AND (CONSP X)
              (NOT (CONSP (CDR X)))
              (INTEGERP N)
              (<= 0 N)
              (RATIONALP U))
         (< (* (LEN X) U) (+ U N 3))).

This simplifies, using the :definitions FIX and LEN, the :executable-
counterpart of BINARY-+ and the :rewrite rules COMMUTATIVITY-2-OF-+,
COMMUTATIVITY-OF-+ and UNICITY-OF-1, to

Goal''
(IMPLIES (AND (CONSP X)
              (NOT (CONSP (CDR X)))
              (INTEGERP N)
              (<= 0 N)
              (RATIONALP U))
         (< U (+ 3 N U))).

But simplification reduces this to T, using linear arithmetic.

Q.E.D.

Summary
Form:  ( THM ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION FIX)
        (:DEFINITION IMPLIES)
        (:DEFINITION LEN)
        (:DEFINITION NOT)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE UNICITY-OF-1))
Warnings:  None
Time:  0.03 seconds (prove: 0.01, print: 0.00, other: 0.02)

Proof succeeded.
ACL2 !>

Good! You found the link to the next command!

The proof above can be described as follows. If X is non-empty but its CDR is empty, then (LEN X) is 1. Arithmetic simplification thus produces Goal''. The conclusion is true because N is non-negative -- a fact recognized by ACL2's linear arithmetic decision procedure. You might want to use the browser's scroll buttons to go back up and look at ACL2's description of its proof. Then click on the next link.

[top] [prev] [next]


[top] [prev] [next]

Insertion Sort

We next illustrate a few theorems about sorting. The plan of the demo is as follows.

Define the Lisp functions insert and isort to do insertion sort.
Prove isort produces ordered output.
Prove isort produces a permutation of its input.
Define a ``buggy'' version of insert and isort.
Show that the buggy isort produces ordered output but not a permutation of its input.

Virtually every time we introduce a function we illustrate its behavior by executing it on a few examples.


[top] [prev] [next]

ACL2 !>(defun insert (e x)
        (cond ((endp x) (cons e x))
              ((< e (car x)) (cons e x))
              (t (cons (car x) (insert e (cdr x))))))

First, read the definition to understand how insert ``works.'' It inserts e into list x just in front of the first element of x that is larger than it. It is defined recursively.

This is our first recursively defined function. A recursive function definition can be admitted to the logic only after proving that the recursion terminates. To do this, ACL2 guesses a measure of the arguments and tries to prove that the measure decreases in a well-founded sense. (If ACL2 cannot guess appropriately, the user can tell it the measure to use.) Which argument above gets smaller as the function recurs?


[top] [prev] [next]

ACL2 !>(defun insert (e x)
        (cond ((endp x) (cons e x))
              ((< e (car x)) (cons e x))
              (t (cons (car x) (insert e (cdr x))))))

The admission of INSERT is trivial, using the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  We observe that the type of INSERT
is described by the theorem (CONSP (INSERT E X)).  We used primitive
type reasoning.

Summary
Form:  ( DEFUN INSERT ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 INSERT
ACL2 !>


[top] [prev] [next]

ACL2 !>(insert 3 '(1 2 4 5))

Here we illustrate an application of insert to put 3 into its proper place in the ordered list (1 2 4 5).


[top] [prev] [next]

ACL2 !>(insert 3 '(1 2 4 5))
(1 2 3 4 5)
ACL2 !>


[top] [prev] [next]

ACL2 !>(defun isort (x)
        (if (endp x)
            nil
          (insert (car x)
                  (isort (cdr x)))))

Another recursive definition. This is the Lisp program that sorts a list of numbers using the insert function just defined.


[top] [prev] [next]

ACL2 !>(defun isort (x)
        (if (endp x)
            nil
          (insert (car x)
                  (isort (cdr x)))))

The admission of ISORT is trivial, using the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  We observe that the type of ISORT
is described by the theorem (OR (CONSP (ISORT X)) (EQUAL (ISORT X) NIL)).
We used the :type-prescription rule INSERT.

Summary
Form:  ( DEFUN ISORT ...)
Rules: ((:TYPE-PRESCRIPTION INSERT))
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.01, other: 0.00)
 ISORT
ACL2 !>


[top] [prev] [next]

ACL2 !>(isort '(5 4 6 7 2 1 0 3))


[top] [prev] [next]

ACL2 !>(isort '(5 4 6 7 2 1 0 3))
(0 1 2 3 4 5 6 7)
ACL2 !>


[top] [prev] [next]

ACL2 !>(defun ordered (x)
        (cond ((endp x) t)
              ((endp (cdr x)) t)
              (t (and (<= (car x) (car (cdr x)))
                      (ordered (cdr x))))))

This defines what we mean by a list being ``ordered.''


[top] [prev] [next]

ACL2 !>(defun ordered (x)
        (cond ((endp x) t)
              ((endp (cdr x)) t)
              (t (and (<= (car x) (car (cdr x)))
                      (ordered (cdr x))))))

The admission of ORDERED is trivial, using the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  We observe that the type of ORDERED
is described by the theorem 
(OR (EQUAL (ORDERED X) T) (EQUAL (ORDERED X) NIL)).  

Summary
Form:  ( DEFUN ORDERED ...)
Rules: NIL
Warnings:  None
Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
 ORDERED
ACL2 !>


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))
T
ACL2 !>


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))
T
ACL2 !>(ordered '(1 2 3 3 4))


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))
T
ACL2 !>(ordered '(1 2 3 3 4))
T
ACL2 !>


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))
T
ACL2 !>(ordered '(1 2 3 3 4))
T
ACL2 !>(ordered '(1 3 2 4))


[top] [prev] [next]

ACL2 !>(ordered '(1 2 3 4))
T
ACL2 !>(ordered '(1 2 3 3 4))
T
ACL2 !>(ordered '(1 3 2 4))
NIL
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm ordered-isort
         (ordered (isort x)))

Here is our first interesting theorem: isort produces ordered output. Can you prove it? After you click on the next link, scroll through the proof using your browser's scroll buttons. We have noted, in blue, an interesting proof step made by the system.


[top] [prev] [next]

ACL2 !>(defthm ordered-isort
         (ordered (isort x)))

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (ISORT X).  If we
let  (:P X) denote *1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X)) (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit ISORT,
namely, the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following two nontautological subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (ORDERED (ISORT (CDR X))))
         (ORDERED (ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (ORDERED (ISORT (CDR X))))
         (ORDERED (ISORT X))).

This simplifies, using the :definition ISORT, to

Subgoal *1/2''
(IMPLIES (AND (CONSP X)
              (ORDERED (ISORT (CDR X))))
         (ORDERED (INSERT (CAR X) (ISORT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/2'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (ORDERED (ISORT X2)))
         (ORDERED (INSERT X1 (ISORT X2)))).

This simplifies, using primitive type reasoning, to

Subgoal *1/2'4'
(IMPLIES (ORDERED (ISORT X2))
         (ORDERED (INSERT X1 (ISORT X2)))).

We generalize this conjecture, replacing (ISORT X2) by IT.  This produces

Subgoal *1/2'5'
(IMPLIES (ORDERED IT)
         (ORDERED (INSERT X1 IT))).

Name the formula above *1.1.

Isn't Subgoal *1/2'5' interesting? The theorem prover has formulated the conjecture that insert produces an ordered list if given one. You might use the scroll buttons on your browser to review how it got to this; it involves a generalization. It will prove this by induction below. But first, it completes the proof of the base case of the induction it is currently in.

We recommend scrolling all the way to the next command link below. It's a long way because several cases arise in the proof that insert preserves the ordered property. We have a little more to say about this proof at the end.


Subgoal *1/1
(IMPLIES (ENDP X) (ORDERED (ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (ORDERED (ISORT X))).

But simplification reduces this to T, using the :definition ISORT and
the :executable-counterpart of ORDERED.

So we now return to *1.1, which is

(IMPLIES (ORDERED IT)
         (ORDERED (INSERT X1 IT))).

Perhaps we can prove *1.1 by induction.  Two induction schemes are
suggested by this conjecture.  These merge into one derived induction
scheme.  

We will induct according to a scheme suggested by (INSERT X1 IT). 
If we let  (:P IT X1) denote *1.1 above then the induction scheme we'll
use is
(AND (IMPLIES (AND (NOT (ENDP IT))
                   (<= (CAR IT) X1)
                   (:P (CDR IT) X1))
              (:P IT X1))
     (IMPLIES (AND (NOT (ENDP IT)) (< X1 (CAR IT)))
              (:P IT X1))
     (IMPLIES (ENDP IT) (:P IT X1))).
This induction is justified by the same argument used to admit INSERT,
namely, the measure (ACL2-COUNT IT) is decreasing according to the
relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  When applied to the goal at hand the above
induction scheme produces the following four nontautological subgoals.

Subgoal *1.1/4
(IMPLIES (AND (NOT (ENDP IT))
              (<= (CAR IT) X1)
              (ORDERED (INSERT X1 (CDR IT)))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/4'
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (ORDERED (INSERT X1 (CDR IT)))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

This simplifies, using the :definitions INSERT and ORDERED, primitive
type reasoning, the :rewrite rules CAR-CONS and CDR-CONS and the :type-
prescription rules INSERT and ORDERED, to the following two conjectures.

Subgoal *1.1/4.2
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (ORDERED (INSERT X1 (CDR IT)))
              (NOT (CONSP (CDR IT))))
         (<= (CAR IT)
             (CAR (INSERT X1 (CDR IT))))).

But simplification reduces this to T, using the :definitions INSERT
and ORDERED, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

Subgoal *1.1/4.1
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (ORDERED (INSERT X1 (CDR IT)))
              (<= (CAR IT) (CADR IT))
              (ORDERED (CDR IT)))
         (<= (CAR IT)
             (CAR (INSERT X1 (CDR IT))))).

The destructor terms (CAR IT) and (CDR IT) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace IT by (CONS IT1 IT2),
generalizing (CAR IT) to IT1 and (CDR IT) to IT2.  (2) Use CAR-CDR-
ELIM, again, to replace IT2 by (CONS IT3 IT4), generalizing (CAR IT2)
to IT3 and (CDR IT2) to IT4.    These steps produce the following two
goals.

Subgoal *1.1/4.1.2
(IMPLIES (AND (NOT (CONSP IT2))
              (CONSP (CONS IT1 IT2))
              (<= IT1 X1)
              (ORDERED (INSERT X1 IT2))
              (<= IT1 (CAR IT2))
              (ORDERED IT2))
         (<= IT1 (CAR (INSERT X1 IT2)))).

But simplification reduces this to T, using the :definitions INSERT
and ORDERED, primitive type reasoning and the :rewrite rules CAR-CONS,
CDR-CONS, DEFAULT-<-1 and DEFAULT-CAR.

Subgoal *1.1/4.1.1
(IMPLIES (AND (CONSP (CONS IT3 IT4))
              (CONSP (LIST* IT1 IT3 IT4))
              (<= IT1 X1)
              (ORDERED (INSERT X1 (CONS IT3 IT4)))
              (<= IT1 IT3)
              (ORDERED (CONS IT3 IT4)))
         (<= IT1 (CAR (INSERT X1 (CONS IT3 IT4))))).

But simplification reduces this to T, using the :definitions INSERT
and ORDERED, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP IT))
              (<= (CAR IT) X1)
              (NOT (ORDERED (CDR IT)))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (NOT (ORDERED (CDR IT)))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

This simplifies, using the :definitions INSERT and ORDERED, primitive
type reasoning, the :rewrite rules CAR-CONS and CDR-CONS and the :type-
prescription rule INSERT, to the following two conjectures.

Subgoal *1.1/3.2
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (NOT (ORDERED (CDR IT)))
              (NOT (CONSP (CDR IT))))
         (<= (CAR IT)
             (CAR (INSERT X1 (CDR IT))))).

But simplification reduces this to T, using the :definition ORDERED.

Subgoal *1.1/3.1
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (NOT (ORDERED (CDR IT)))
              (NOT (CONSP (CDR IT))))
         (ORDERED (INSERT X1 (CDR IT)))).

But simplification reduces this to T, using the :definition ORDERED.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP IT))
              (< X1 (CAR IT))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP IT)
              (< X1 (CAR IT))
              (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

This simplifies, using the :definitions INSERT and ORDERED, primitive
type reasoning, the :rewrite rules CAR-CONS and CDR-CONS and the :type-
prescription rule ORDERED, to the following two conjectures.

Subgoal *1.1/2.2
(IMPLIES (AND (CONSP IT)
              (< X1 (CAR IT))
              (NOT (CONSP (CDR IT))))
         (<= X1 (CAR IT))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1.1/2.1
(IMPLIES (AND (CONSP IT)
              (< X1 (CAR IT))
              (<= (CAR IT) (CADR IT))
              (ORDERED (CDR IT)))
         (<= X1 (CAR IT))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1.1/1
(IMPLIES (AND (ENDP IT) (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (AND (NOT (CONSP IT)) (ORDERED IT))
         (ORDERED (INSERT X1 IT))).

But simplification reduces this to T, using the :definitions INSERT
and ORDERED, primitive type reasoning and the :rewrite rule CDR-CONS.

That completes the proofs of *1.1 and *1.

Q.E.D.

The storage of ORDERED-ISORT depends upon the :type-prescription rule
ORDERED.

Summary
Form:  ( DEFTHM ORDERED-ISORT ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION INSERT)
        (:DEFINITION ISORT)
        (:DEFINITION NOT)
        (:DEFINITION ORDERED)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ORDERED)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE DEFAULT-<-1)
        (:REWRITE DEFAULT-CAR)
        (:TYPE-PRESCRIPTION INSERT)
        (:TYPE-PRESCRIPTION ORDERED))
Warnings:  None
Time:  0.35 seconds (prove: 0.26, print: 0.08, other: 0.01)
 ORDERED-ISORT
ACL2 !>

Notice that even though this proof description is long, the time taken to produce it it is quite short. Most users do not read the output produced by successful proofs, except to confirm that the theorem prover is following the strategy the user envisioned.

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(pe 'perm)

We cannot be sure that isort is correct just because it produces ordered output. It might always return nil! We next prove that it produces a permutation of its input.

How would you define perm? We have already loaded a definition into the system in this session. This command will show you that definition. Read it and see whether it agrees with your ideas.


[top] [prev] [next]

ACL2 !>(pe 'perm)
   d      2  (INCLUDE-BOOK "isort")
             \
>L            (DEFUN PERM (X Y)
                     (IF (CONSP X)
                         (AND (MEM (CAR X) Y)
                              (PERM (CDR X) (DEL (CAR X) Y)))
                         (NOT (CONSP Y))))
ACL2 !>

This strange output means that the definition of perm was contained in a book called "isort" which was included as the second command in the session. (That command happened before the demo began.)

To read the definition above, think of it trying to determine whether x is a permutation of y. If x is a cons, then the first element of x must be a member of y and the rest of x must be a permutation of the result of deleting the first element of x from y. If, on the other hand, x is not a cons, i.e., if x is empty, then y must be empty also.


[top] [prev] [next]

ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 3))


[top] [prev] [next]

ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 3))
T
ACL2 !>


[top] [prev] [next]

ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 3))
T
ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 2))


[top] [prev] [next]

ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 3))
T
ACL2 !>(perm '(1 2 3 3 4) '(4 3 1 2 2))
NIL
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm perm-isort
         (perm (isort x) x))

So here is the theorem that says isort produces a permutation of its input. The proof is interesting because it involves another generalization to produce an inductively provable fact about insert, and because it uses perm as an equivalence relation to rewrite certain terms. Follow the proof.


[top] [prev] [next]

ACL2 !>(defthm perm-isort
         (perm (isort x) x))

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (ISORT X).  If we
let  (:P X) denote *1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X)) (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit ISORT,
namely, the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following two nontautological subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (PERM (ISORT (CDR X)) (CDR X)))
         (PERM (ISORT X) X)).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (PERM (ISORT (CDR X)) (CDR X)))
         (PERM (ISORT X) X)).

This simplifies, using the :definition ISORT, to

Subgoal *1/2''
(IMPLIES (AND (CONSP X)
              (PERM (ISORT (CDR X)) (CDR X)))
         (PERM (INSERT (CAR X) (ISORT (CDR X)))
               X)).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/2'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (PERM (ISORT X2) X2))
         (PERM (INSERT X1 (ISORT X2))
               (CONS X1 X2))).

This simplifies, using primitive type reasoning, to

Subgoal *1/2'4'
(IMPLIES (PERM (ISORT X2) X2)
         (PERM (INSERT X1 (ISORT X2))
               (CONS X1 X2))).

We generalize this conjecture, replacing (ISORT X2) by IT.  This produces

Subgoal *1/2'5'
(IMPLIES (PERM IT X2)
         (PERM (INSERT X1 IT) (CONS X1 X2))).

This simplifies, using the :congruence rule PERM-IMPLIES-PERM-CONS-
2, to

Subgoal *1/2'6'
(PERM (INSERT X1 IT) (CONS X1 IT)).

Name the formula above *1.1.

Subgoal *1/1
(IMPLIES (ENDP X) (PERM (ISORT X) X)).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (PERM (ISORT X) X)).

But simplification reduces this to T, using the :definitions ISORT
and PERM and the :executable-counterpart of CONSP.

So we now return to *1.1, which is

(PERM (INSERT X1 IT) (CONS X1 IT)).

Perhaps we can prove *1.1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (INSERT X1 IT). 
If we let  (:P IT X1) denote *1.1 above then the induction scheme we'll
use is
(AND (IMPLIES (AND (NOT (ENDP IT))
                   (<= (CAR IT) X1)
                   (:P (CDR IT) X1))
              (:P IT X1))
     (IMPLIES (AND (NOT (ENDP IT)) (< X1 (CAR IT)))
              (:P IT X1))
     (IMPLIES (ENDP IT) (:P IT X1))).
This induction is justified by the same argument used to admit INSERT,
namely, the measure (ACL2-COUNT IT) is decreasing according to the
relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  When applied to the goal at hand the above
induction scheme produces the following three nontautological subgoals.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP IT))
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT))))
         (PERM (INSERT X1 IT) (CONS X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT))))
         (PERM (INSERT X1 IT) (CONS X1 IT))).

This simplifies, using the :congruence rule PERM-IMPLIES-PERM-CONS-
2, the :definitions DEL, INSERT, MEM and PERM, primitive type reasoning
and the :rewrite rules CAR-CONS and CDR-CONS, to the following four
conjectures.

Subgoal *1.1/3.4
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT)))
              (EQUAL (CAR IT) X1))
         (MEM X1 IT)).

But simplification reduces this to T, using the :definition MEM, primitive
type reasoning and the :rewrite rule CAR-CDR-ELIM.

Subgoal *1.1/3.3
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT)))
              (EQUAL (CAR IT) X1))
         (PERM (CDR IT) (DEL X1 IT))).

But simplification reduces this to T, using the :definitions DEL, MEM
and PERM, primitive type reasoning and the :rewrite rule CAR-CDR-ELIM.

Subgoal *1.1/3.2
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT)))
              (NOT (EQUAL (CAR IT) X1)))
         (MEM X1 (CONS X1 (CDR IT)))).

But simplification reduces this to T, using the :definition MEM, primitive
type reasoning and the :rewrite rule CAR-CONS.

Subgoal *1.1/3.1
(IMPLIES (AND (CONSP IT)
              (<= (CAR IT) X1)
              (PERM (INSERT X1 (CDR IT))
                    (CONS X1 (CDR IT)))
              (NOT (EQUAL (CAR IT) X1)))
         (PERM (CDR IT)
               (DEL X1 (CONS X1 (CDR IT))))).

But simplification reduces this to T, using the :definitions DEL, MEM
and PERM, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP IT)) (< X1 (CAR IT)))
         (PERM (INSERT X1 IT) (CONS X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP IT) (< X1 (CAR IT)))
         (PERM (INSERT X1 IT) (CONS X1 IT))).

But simplification reduces this to T, using the :definitions DEL, INSERT,
MEM and PERM, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

Subgoal *1.1/1
(IMPLIES (ENDP IT)
         (PERM (INSERT X1 IT) (CONS X1 IT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (NOT (CONSP IT))
         (PERM (INSERT X1 IT) (CONS X1 IT))).

But simplification reduces this to T, using the :definitions DEL, INSERT,
MEM and PERM, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

That completes the proofs of *1.1 and *1.

Q.E.D.

Summary
Form:  ( DEFTHM PERM-ISORT ...)
Rules: ((:CONGRUENCE PERM-IMPLIES-PERM-CONS-2)
        (:DEFINITION DEL)
        (:DEFINITION ENDP)
        (:DEFINITION INSERT)
        (:DEFINITION ISORT)
        (:DEFINITION MEM)
        (:DEFINITION NOT)
        (:DEFINITION PERM)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CDR-ELIM)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS))
Warnings:  None
Time:  0.29 seconds (prove: 0.21, print: 0.06, other: 0.02)
 PERM-ISORT
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defun buggy-insert (e x)
        (cond ((endp x) x)
              ((< e (car x)) (cons e x))
              (t (cons (car x) (buggy-insert e (cdr x))))))

Now we define an ``insert'' function that doesn't work quite right. Do you see the problem?


[top] [prev] [next]

ACL2 !>(defun buggy-insert (e x)
        (cond ((endp x) x)
              ((< e (car x)) (cons e x))
              (t (cons (car x) (buggy-insert e (cdr x))))))

The admission of BUGGY-INSERT is trivial, using the relation E0-ORD-
< (which is known to be well-founded on the domain recognized by E0-
ORDINALP) and the measure (ACL2-COUNT X).  We could deduce no constraints
on the type of BUGGY-INSERT.

Summary
Form:  ( DEFUN BUGGY-INSERT ...)
Rules: NIL
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 BUGGY-INSERT
ACL2 !>


[top] [prev] [next]

ACL2 !>(buggy-insert 3 '(1 2 4 5))


[top] [prev] [next]

ACL2 !>(buggy-insert 3 '(1 2 4 5))
(1 2 3 4 5)
ACL2 !>


[top] [prev] [next]

ACL2 !>(buggy-insert 3 '(1 2 4 5))
(1 2 3 4 5)
ACL2 !>(buggy-insert 3 '(1 2))


[top] [prev] [next]

ACL2 !>(buggy-insert 3 '(1 2 4 5))
(1 2 3 4 5)
ACL2 !>(buggy-insert 3 '(1 2))
(1 2)
ACL2 !>

Oops! The first test worked but the second one didn't. We don't insert properly if we have to do it at the end of the list. But let's pretend we didn't notice this bad test and define a sort program in terms of this bad insertion program.


[top] [prev] [next]

ACL2 !>(defun buggy-isort (x)
        (if (endp x)
            nil
          (buggy-insert (car x)
                        (buggy-isort (cdr x)))))


[top] [prev] [next]

ACL2 !>(defun buggy-isort (x)
        (if (endp x)
            nil
          (buggy-insert (car x)
                        (buggy-isort (cdr x)))))

The admission of BUGGY-ISORT is trivial, using the relation E0-ORD-
< (which is known to be well-founded on the domain recognized by E0-
ORDINALP) and the measure (ACL2-COUNT X).  We could deduce no constraints
on the type of BUGGY-ISORT.

Summary
Form:  ( DEFUN BUGGY-ISORT ...)
Rules: NIL
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 BUGGY-ISORT
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm ordered-buggy-isort
         (ordered (buggy-isort x)))

Does this bad sort program produce ordered output?


[top] [prev] [next]

ACL2 !>(defthm ordered-buggy-isort
         (ordered (buggy-isort x)))

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (BUGGY-ISORT X).
If we let  (:P X) denote *1 above then the induction scheme we'll use
is
(AND (IMPLIES (AND (NOT (ENDP X)) (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit BUGGY-
ISORT, namely, the measure (ACL2-COUNT X) is decreasing according to
the relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  When applied to the goal at hand the above
induction scheme produces the following two nontautological subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (ORDERED (BUGGY-ISORT (CDR X))))
         (ORDERED (BUGGY-ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (ORDERED (BUGGY-ISORT (CDR X))))
         (ORDERED (BUGGY-ISORT X))).

This simplifies, using the :definition BUGGY-ISORT, to

Subgoal *1/2''
(IMPLIES (AND (CONSP X)
              (ORDERED (BUGGY-ISORT (CDR X))))
         (ORDERED (BUGGY-INSERT (CAR X)
                                (BUGGY-ISORT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/2'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (ORDERED (BUGGY-ISORT X2)))
         (ORDERED (BUGGY-INSERT X1 (BUGGY-ISORT X2)))).

This simplifies, using primitive type reasoning, to

Subgoal *1/2'4'
(IMPLIES (ORDERED (BUGGY-ISORT X2))
         (ORDERED (BUGGY-INSERT X1 (BUGGY-ISORT X2)))).

We generalize this conjecture, replacing (BUGGY-ISORT X2) by BIT. 
This produces

Subgoal *1/2'5'
(IMPLIES (ORDERED BIT)
         (ORDERED (BUGGY-INSERT X1 BIT))).

Name the formula above *1.1.

Subgoal *1/1
(IMPLIES (ENDP X)
         (ORDERED (BUGGY-ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (ORDERED (BUGGY-ISORT X))).

But simplification reduces this to T, using the :definition BUGGY-ISORT
and the :executable-counterpart of ORDERED.

So we now return to *1.1, which is

(IMPLIES (ORDERED BIT)
         (ORDERED (BUGGY-INSERT X1 BIT))).

Perhaps we can prove *1.1 by induction.  Two induction schemes are
suggested by this conjecture.  These merge into one derived induction
scheme.  

We will induct according to a scheme suggested by (BUGGY-INSERT X1 BIT).
If we let  (:P BIT X1) denote *1.1 above then the induction scheme
we'll use is
(AND (IMPLIES (AND (NOT (ENDP BIT))
                   (<= (CAR BIT) X1)
                   (:P (CDR BIT) X1))
              (:P BIT X1))
     (IMPLIES (AND (NOT (ENDP BIT)) (< X1 (CAR BIT)))
              (:P BIT X1))
     (IMPLIES (ENDP BIT) (:P BIT X1))).
This induction is justified by the same argument used to admit BUGGY-
INSERT, namely, the measure (ACL2-COUNT BIT) is decreasing according
to the relation E0-ORD-< (which is known to be well-founded on the
domain recognized by E0-ORDINALP).  When applied to the goal at hand
the above induction scheme produces the following four nontautological
subgoals.

Subgoal *1.1/4
(IMPLIES (AND (NOT (ENDP BIT))
              (<= (CAR BIT) X1)
              (ORDERED (BUGGY-INSERT X1 (CDR BIT)))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/4'
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (ORDERED (BUGGY-INSERT X1 (CDR BIT)))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

This simplifies, using the :definitions BUGGY-INSERT and ORDERED, primitive
type reasoning, the :rewrite rules CAR-CONS and CDR-CONS and the :type-
prescription rule ORDERED, to the following two conjectures.

Subgoal *1.1/4.2
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (ORDERED (BUGGY-INSERT X1 (CDR BIT)))
              (NOT (CONSP (CDR BIT)))
              (CONSP (BUGGY-INSERT X1 (CDR BIT))))
         (<= (CAR BIT)
             (CAR (BUGGY-INSERT X1 (CDR BIT))))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT and ORDERED.

Subgoal *1.1/4.1
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (ORDERED (BUGGY-INSERT X1 (CDR BIT)))
              (<= (CAR BIT) (CADR BIT))
              (ORDERED (CDR BIT))
              (CONSP (BUGGY-INSERT X1 (CDR BIT))))
         (<= (CAR BIT)
             (CAR (BUGGY-INSERT X1 (CDR BIT))))).

The destructor terms (CAR BIT) and (CDR BIT) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace BIT by (CONS BIT1 BIT2),
generalizing (CAR BIT) to BIT1 and (CDR BIT) to BIT2.  (2) Use CAR-
CDR-ELIM, again, to replace BIT2 by (CONS BIT3 BIT4), generalizing
(CAR BIT2) to BIT3 and (CDR BIT2) to BIT4.    These steps produce the
following two goals.

Subgoal *1.1/4.1.2
(IMPLIES (AND (NOT (CONSP BIT2))
              (CONSP (CONS BIT1 BIT2))
              (<= BIT1 X1)
              (ORDERED (BUGGY-INSERT X1 BIT2))
              (<= BIT1 (CAR BIT2))
              (ORDERED BIT2)
              (CONSP (BUGGY-INSERT X1 BIT2)))
         (<= BIT1 (CAR (BUGGY-INSERT X1 BIT2)))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT and ORDERED, primitive type reasoning and the :rewrite rules
DEFAULT-<-1 and DEFAULT-CAR.

Subgoal *1.1/4.1.1
(IMPLIES (AND (CONSP (CONS BIT3 BIT4))
              (CONSP (LIST* BIT1 BIT3 BIT4))
              (<= BIT1 X1)
              (ORDERED (BUGGY-INSERT X1 (CONS BIT3 BIT4)))
              (<= BIT1 BIT3)
              (ORDERED (CONS BIT3 BIT4))
              (CONSP (BUGGY-INSERT X1 (CONS BIT3 BIT4))))
         (<= BIT1
             (CAR (BUGGY-INSERT X1 (CONS BIT3 BIT4))))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT and ORDERED, primitive type reasoning and the :rewrite rules
CAR-CONS and CDR-CONS.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP BIT))
              (<= (CAR BIT) X1)
              (NOT (ORDERED (CDR BIT)))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (NOT (ORDERED (CDR BIT)))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

This simplifies, using the :definitions BUGGY-INSERT and ORDERED, primitive
type reasoning and the :rewrite rules CAR-CONS and CDR-CONS, to the
following two conjectures.

Subgoal *1.1/3.2
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (NOT (ORDERED (CDR BIT)))
              (NOT (CONSP (CDR BIT)))
              (CONSP (BUGGY-INSERT X1 (CDR BIT))))
         (<= (CAR BIT)
             (CAR (BUGGY-INSERT X1 (CDR BIT))))).

But simplification reduces this to T, using the :definition ORDERED.

Subgoal *1.1/3.1
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (NOT (ORDERED (CDR BIT)))
              (NOT (CONSP (CDR BIT)))
              (CONSP (BUGGY-INSERT X1 (CDR BIT))))
         (ORDERED (BUGGY-INSERT X1 (CDR BIT)))).

But simplification reduces this to T, using the :definition ORDERED.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP BIT))
              (< X1 (CAR BIT))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP BIT)
              (< X1 (CAR BIT))
              (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

This simplifies, using the :definitions BUGGY-INSERT and ORDERED, primitive
type reasoning, the :rewrite rules CAR-CONS and CDR-CONS and the :type-
prescription rule ORDERED, to the following two conjectures.

Subgoal *1.1/2.2
(IMPLIES (AND (CONSP BIT)
              (< X1 (CAR BIT))
              (NOT (CONSP (CDR BIT))))
         (<= X1 (CAR BIT))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1.1/2.1
(IMPLIES (AND (CONSP BIT)
              (< X1 (CAR BIT))
              (<= (CAR BIT) (CADR BIT))
              (ORDERED (CDR BIT)))
         (<= X1 (CAR BIT))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1.1/1
(IMPLIES (AND (ENDP BIT) (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (AND (NOT (CONSP BIT)) (ORDERED BIT))
         (ORDERED (BUGGY-INSERT X1 BIT))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT and ORDERED.

That completes the proofs of *1.1 and *1.

Q.E.D.

The storage of ORDERED-BUGGY-ISORT depends upon the :type-prescription
rule ORDERED.

Summary
Form:  ( DEFTHM ORDERED-BUGGY-ISORT ...)
Rules: ((:DEFINITION BUGGY-INSERT)
        (:DEFINITION BUGGY-ISORT)
        (:DEFINITION ENDP)
        (:DEFINITION NOT)
        (:DEFINITION ORDERED)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ORDERED)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE DEFAULT-<-1)
        (:REWRITE DEFAULT-CAR)
        (:TYPE-PRESCRIPTION ORDERED))
Warnings:  None
Time:  0.55 seconds (prove: 0.39, print: 0.15, other: 0.01)
 ORDERED-BUGGY-ISORT
ACL2 !>

Yes! Buggy-isort produces ordered output.

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm perm-buggy-isort
         (perm (buggy-isort x) x))

ACL2 successfully proved that buggy-isort produces ordered output. So now we try to prove that it produces a permutation of its input.

The proof will fail after you click on the next link above. This is the first failed proof in the demo. Even though the proof attempt is long, you should scroll down to the end of it, where we have more to say.

The proof attempt you are about to see can be described as follows. We'll induct to unwind buggy-isort. The induction step generates an interesting lemma about buggy-insert, which we start proving after we prove the base case of the first induction. When we turn to the lemma about buggy-insert we do another induction to unwind that recursion. The induction step of that induction is successfully completed. The base case, however, fails. Don't bother with the details but skim the proof looking for the basic structure.


[top] [prev] [next]

ACL2 !>(defthm perm-buggy-isort
         (perm (buggy-isort x) x))

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (BUGGY-ISORT X).
If we let  (:P X) denote *1 above then the induction scheme we'll use
is
(AND (IMPLIES (AND (NOT (ENDP X)) (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit BUGGY-
ISORT, namely, the measure (ACL2-COUNT X) is decreasing according to
the relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  When applied to the goal at hand the above
induction scheme produces the following two nontautological subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (PERM (BUGGY-ISORT (CDR X)) (CDR X)))
         (PERM (BUGGY-ISORT X) X)).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (PERM (BUGGY-ISORT (CDR X)) (CDR X)))
         (PERM (BUGGY-ISORT X) X)).

This simplifies, using the :definition BUGGY-ISORT, to

Subgoal *1/2''
(IMPLIES (AND (CONSP X)
              (PERM (BUGGY-ISORT (CDR X)) (CDR X)))
         (PERM (BUGGY-INSERT (CAR X)
                             (BUGGY-ISORT (CDR X)))
               X)).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/2'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (PERM (BUGGY-ISORT X2) X2))
         (PERM (BUGGY-INSERT X1 (BUGGY-ISORT X2))
               (CONS X1 X2))).

This simplifies, using primitive type reasoning, to

Subgoal *1/2'4'
(IMPLIES (PERM (BUGGY-ISORT X2) X2)
         (PERM (BUGGY-INSERT X1 (BUGGY-ISORT X2))
               (CONS X1 X2))).

We generalize this conjecture, replacing (BUGGY-ISORT X2) by BIT. 
This produces

Subgoal *1/2'5'
(IMPLIES (PERM BIT X2)
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 X2))).

This simplifies, using the :congruence rule PERM-IMPLIES-PERM-CONS-
2, to

Subgoal *1/2'6'
(PERM (BUGGY-INSERT X1 BIT)
      (CONS X1 BIT)).

Name the formula above *1.1.

Subgoal *1/1
(IMPLIES (ENDP X)
         (PERM (BUGGY-ISORT X) X)).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (PERM (BUGGY-ISORT X) X)).

But simplification reduces this to T, using the :definitions BUGGY-
ISORT and PERM and the :executable-counterpart of CONSP.

So we now return to *1.1, which is

(PERM (BUGGY-INSERT X1 BIT)
      (CONS X1 BIT)).

Perhaps we can prove *1.1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (BUGGY-INSERT X1 BIT).
If we let  (:P BIT X1) denote *1.1 above then the induction scheme
we'll use is
(AND (IMPLIES (AND (NOT (ENDP BIT))
                   (<= (CAR BIT) X1)
                   (:P (CDR BIT) X1))
              (:P BIT X1))
     (IMPLIES (AND (NOT (ENDP BIT)) (< X1 (CAR BIT)))
              (:P BIT X1))
     (IMPLIES (ENDP BIT) (:P BIT X1))).
This induction is justified by the same argument used to admit BUGGY-
INSERT, namely, the measure (ACL2-COUNT BIT) is decreasing according
to the relation E0-ORD-< (which is known to be well-founded on the
domain recognized by E0-ORDINALP).  When applied to the goal at hand
the above induction scheme produces the following three nontautological
subgoals.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP BIT))
              (<= (CAR BIT) X1)
              (PERM (BUGGY-INSERT X1 (CDR BIT))
                    (CONS X1 (CDR BIT))))
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (PERM (BUGGY-INSERT X1 (CDR BIT))
                    (CONS X1 (CDR BIT))))
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

This simplifies, using the :definitions BUGGY-INSERT, DEL, MEM and
PERM, the :equivalence rule PERM-IS-AN-EQUIVALENCE, primitive type
reasoning and the :rewrite rules CAR-CONS and CDR-CONS, to the following
two conjectures.

Subgoal *1.1/3.2
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (PERM (BUGGY-INSERT X1 (CDR BIT))
                    (CONS X1 (CDR BIT)))
              (EQUAL (CAR BIT) X1))
         (PERM (BUGGY-INSERT X1 (CDR BIT)) BIT)).

But simplification reduces this to T, using the :rewrite rule CAR-CDR-
ELIM.

Subgoal *1.1/3.1
(IMPLIES (AND (CONSP BIT)
              (<= (CAR BIT) X1)
              (PERM (BUGGY-INSERT X1 (CDR BIT))
                    (CONS X1 (CDR BIT)))
              (NOT (EQUAL (CAR BIT) X1)))
         (PERM (BUGGY-INSERT X1 (CDR BIT))
               (BUGGY-INSERT X1 (CDR BIT)))).

But simplification reduces this to T, using primitive type reasoning.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP BIT)) (< X1 (CAR BIT)))
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP BIT) (< X1 (CAR BIT)))
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT, DEL, MEM and PERM, primitive type reasoning and the :rewrite
rules CAR-CONS and CDR-CONS.

Subgoal *1.1/1
(IMPLIES (ENDP BIT)
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (NOT (CONSP BIT))
         (PERM (BUGGY-INSERT X1 BIT)
               (CONS X1 BIT))).

This simplifies, using the :definitions BUGGY-INSERT and PERM and primitive
type reasoning, to

Subgoal *1.1/1''
(CONSP BIT).

We suspect that this conjecture is not a theorem.  We might as well
be trying to prove

Subgoal *1.1/1'''
NIL.

Obviously, the proof attempt has failed.

Summary
Form:  ( DEFTHM PERM-BUGGY-ISORT ...)
Rules: ((:CONGRUENCE PERM-IMPLIES-PERM-CONS-2)
        (:DEFINITION BUGGY-INSERT)
        (:DEFINITION BUGGY-ISORT)
        (:DEFINITION DEL)
        (:DEFINITION ENDP)
        (:DEFINITION MEM)
        (:DEFINITION NOT)
        (:DEFINITION PERM)
        (:ELIM CAR-CDR-ELIM)
        (:EQUIVALENCE PERM-IS-AN-EQUIVALENCE)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CDR-ELIM)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS))
Warnings:  None
Time:  0.24 seconds (prove: 0.15, print: 0.07, other: 0.02)

******** FAILED ********  See :DOC failure  ******** FAILED ********
ACL2 !>

Technically, all that we know now is that ACL2, with its current data base of rules, cannot prove the conjecture that buggy-isort produces a permutation of its input. We do not know from this failed proof that the function does not have the property!

But if you inspect the proof attempt above you will see that it reveals a problem with buggy-insert. The problem is that it fails to insert the element into the empty list.

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm buggy-isort-is-nil
         (equal (buggy-isort x) nil))

If you think about buggy-isort, you will see that it builds its answer from nil by repeatedly inserting elements into it. Since that always returns nil, we can see that buggy-isort manages to return an ordered list by always returning the empty list! We can prove that.


[top] [prev] [next]

ACL2 !>(defthm buggy-isort-is-nil
         (equal (buggy-isort x) nil))

By case analysis we reduce the conjecture to

Goal'
(NOT (BUGGY-ISORT X)).

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (BUGGY-ISORT X).
If we let  (:P X) denote *1 above then the induction scheme we'll use
is
(AND (IMPLIES (AND (NOT (ENDP X)) (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit BUGGY-
ISORT, namely, the measure (ACL2-COUNT X) is decreasing according to
the relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  When applied to the goal at hand the above
induction scheme produces the following two nontautological subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (NOT (BUGGY-ISORT (CDR X))))
         (NOT (BUGGY-ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (NOT (BUGGY-ISORT (CDR X))))
         (NOT (BUGGY-ISORT X))).

But simplification reduces this to T, using the :definitions BUGGY-
INSERT and BUGGY-ISORT and the :executable-counterpart of CONSP.

Subgoal *1/1
(IMPLIES (ENDP X)
         (NOT (BUGGY-ISORT X))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (NOT (BUGGY-ISORT X))).

But simplification reduces this to T, using the :definition BUGGY-ISORT.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM BUGGY-ISORT-IS-NIL ...)
Rules: ((:DEFINITION BUGGY-INSERT)
        (:DEFINITION BUGGY-ISORT)
        (:DEFINITION ENDP)
        (:DEFINITION NOT)
        (:EXECUTABLE-COUNTERPART CONSP))
Warnings:  None
Time:  0.03 seconds (prove: 0.01, print: 0.01, other: 0.01)
 BUGGY-ISORT-IS-NIL
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

Bit Vector Addition and Multiplication

We now turn to bit vector manipulation. We represent bit vectors as lists of Booleans. To keep things simple, we store the least significant bit in the car of the vector; thus our vectors have the least significant bit on the left and the most significant bit on the right, contrary to normal usage. But this makes our particular recursive definitions convenient.

The plan of the demo is as follows:

Define a ripple-carry bit vector adder that works on arbitrarily long vectors.
Define the function that maps bit vectors to natural numbers.
Prove that the ``adder adds'' in the arithmetic sense.
Do the same for a shift-and-add bit vector multiplier.


[top] [prev] [next]

ACL2 !>(defun full-adder (p q c)
        (mv (xor p (xor q c))
            (maj p q c)))


[top] [prev] [next]

ACL2 !>(defun full-adder (p q c)
        (mv (xor p (xor q c))
            (maj p q c)))

Since FULL-ADDER is non-recursive, its admission is trivial.  We observe
that the type of FULL-ADDER is described by the theorem 
(AND (CONSP (FULL-ADDER P Q C)) (TRUE-LISTP (FULL-ADDER P Q C))). 
We used primitive type reasoning.

(FULL-ADDER * * *) => (MV * *).

Summary
Form:  ( DEFUN FULL-ADDER ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Warnings:  None
Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
 FULL-ADDER
ACL2 !>

The MV form is used in ACL2 to return ``multiple values.'' In this case, the function returns two values, the sum and carry out.


[top] [prev] [next]

ACL2 !>(full-adder t t nil)


[top] [prev] [next]

ACL2 !>(full-adder t t nil)
(NIL T)
ACL2 !>


[top] [prev] [next]

ACL2 !>(full-adder t t nil)
(NIL T)
ACL2 !>(full-adder nil nil t)


[top] [prev] [next]

ACL2 !>(full-adder t t nil)
(NIL T)
ACL2 !>(full-adder nil nil t)
(T NIL)
ACL2 !>


[top] [prev] [next]

ACL2 !>(defun serial-adder (a b c)
        (declare (xargs :measure (+ (acl2-count a) (acl2-count b))))
        (if (and (endp a) (endp b))
            (list c)
          (mv-let (sum cout)
                  (full-adder (car a) (car b) c)
                  (cons sum (serial-adder (cdr a) (cdr b) cout)))))

The MV-LET form in ACL2 is used to bind variables to the multiple values returned by a function. The else-branch of the if above means ``bind sum and cout, respectively, to the first and second outputs of the call of full-adder and then return the result of consing the sum bit onto the vector obtained by serially adding the rest of the input vectors using cout as the carry in.

The admission of this function is tedious. Note that we have to tell ACL2 an appropriate measure. That is because the function continues to recur as long as either argument is non-empty.


[top] [prev] [next]

ACL2 !>(defun serial-adder (a b c)
        (declare (xargs :measure (+ (acl2-count a) (acl2-count b))))
        (if (and (endp a) (endp b))
            (list c)
          (mv-let (sum cout)
                  (full-adder (car a) (car b) c)
                  (cons sum (serial-adder (cdr a) (cdr b) cout)))))

For the admission of SERIAL-ADDER we will use the relation E0-ORD-<
(which is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (+ (ACL2-COUNT A) (ACL2-COUNT B)).  The non-trivial
part of the measure conjecture is

Goal
(AND (E0-ORDINALP (+ (ACL2-COUNT A) (ACL2-COUNT B)))
     (IMPLIES (NOT (AND (ENDP A) (ENDP B)))
              (E0-ORD-< (+ (ACL2-COUNT (CDR A))
                           (ACL2-COUNT (CDR B)))
                        (+ (ACL2-COUNT A) (ACL2-COUNT B))))).

By case analysis we reduce the conjecture to the following two conjectures.

Subgoal 2
(E0-ORDINALP (+ (ACL2-COUNT A) (ACL2-COUNT B))).

But simplification reduces this to T, using the :definition E0-ORDINALP,
primitive type reasoning and the :type-prescription rule ACL2-COUNT.

Subgoal 1
(IMPLIES (NOT (AND (ENDP A) (ENDP B)))
         (E0-ORD-< (+ (ACL2-COUNT (CDR A))
                      (ACL2-COUNT (CDR B)))
                   (+ (ACL2-COUNT A) (ACL2-COUNT B)))).

This simplifies, using the :definitions E0-ORD-< and ENDP, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to the following
two conjectures.

Subgoal 1.2
(IMPLIES (CONSP A)
         (< (+ (ACL2-COUNT (CDR A))
               (ACL2-COUNT (CDR B)))
            (+ (ACL2-COUNT A) (ACL2-COUNT B)))).

The destructor terms (CAR B) and (CDR B) can be eliminated by using
CAR-CDR-ELIM to replace B by (CONS B1 B2), generalizing (CAR B) to
B1 and (CDR B) to B2.  This produces the following two goals.

Subgoal 1.2.2
(IMPLIES (AND (NOT (CONSP B)) (CONSP A))
         (< (+ (ACL2-COUNT (CDR A))
               (ACL2-COUNT (CDR B)))
            (+ (ACL2-COUNT A) (ACL2-COUNT B)))).

This simplifies, using the :definition FIX, the :executable-counterpart
of ACL2-COUNT, the :rewrite rules COMMUTATIVITY-OF-+, DEFAULT-CDR and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 1.2.2'
(IMPLIES (AND (NOT (CONSP B)) (CONSP A))
         (< (ACL2-COUNT (CDR A))
            (+ (ACL2-COUNT A) (ACL2-COUNT B)))).

The destructor terms (CAR A) and (CDR A) can be eliminated by using
CAR-CDR-ELIM to replace A by (CONS A1 A2), generalizing (CAR A) to
A1 and (CDR A) to A2.  This produces the following goal.

Subgoal 1.2.2''
(IMPLIES (AND (CONSP (CONS A1 A2))
              (NOT (CONSP B)))
         (< (ACL2-COUNT A2)
            (+ (ACL2-COUNT (CONS A1 A2))
               (ACL2-COUNT B)))).

This simplifies, using the :definition ACL2-COUNT, primitive type reasoning
and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+ and
COMMUTATIVITY-OF-+, to

Subgoal 1.2.2'''
(IMPLIES (NOT (CONSP B))
         (< (ACL2-COUNT A2)
            (+ 1 (ACL2-COUNT A1)
               (ACL2-COUNT A2)
               (ACL2-COUNT B)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1.2.1
(IMPLIES (AND (CONSP (CONS B1 B2)) (CONSP A))
         (< (+ (ACL2-COUNT (CDR A)) (ACL2-COUNT B2))
            (+ (ACL2-COUNT A)
               (ACL2-COUNT (CONS B1 B2))))).

This simplifies, using the :definition ACL2-COUNT, primitive type reasoning
and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+ and
COMMUTATIVITY-OF-+, to

Subgoal 1.2.1'
(IMPLIES (CONSP A)
         (< (+ (ACL2-COUNT B2) (ACL2-COUNT (CDR A)))
            (+ 1 (ACL2-COUNT A)
               (ACL2-COUNT B1)
               (ACL2-COUNT B2)))).

The destructor terms (CAR A) and (CDR A) can be eliminated by using
CAR-CDR-ELIM to replace A by (CONS A1 A2), generalizing (CAR A) to
A1 and (CDR A) to A2.  This produces the following goal.

Subgoal 1.2.1''
(IMPLIES (CONSP (CONS A1 A2))
         (< (+ (ACL2-COUNT B2) (ACL2-COUNT A2))
            (+ 1 (ACL2-COUNT (CONS A1 A2))
               (ACL2-COUNT B1)
               (ACL2-COUNT B2)))).

This simplifies, using the :definitions ACL2-COUNT and SYNTAXP, the
:executable-counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive
type reasoning and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
2-OF-+, COMMUTATIVITY-OF-+ and FOLD-CONSTS-IN-+, to

Subgoal 1.2.1'''
(< (+ (ACL2-COUNT A2) (ACL2-COUNT B2))
   (+ 2 (ACL2-COUNT A1)
      (ACL2-COUNT A2)
      (ACL2-COUNT B1)
      (ACL2-COUNT B2))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1.1
(IMPLIES (CONSP B)
         (< (+ (ACL2-COUNT (CDR A))
               (ACL2-COUNT (CDR B)))
            (+ (ACL2-COUNT A) (ACL2-COUNT B)))).

The destructor terms (CAR B) and (CDR B) can be eliminated by using
CAR-CDR-ELIM to replace B by (CONS B1 B2), generalizing (CAR B) to
B1 and (CDR B) to B2.  This produces the following goal.

Subgoal 1.1'
(IMPLIES (CONSP (CONS B1 B2))
         (< (+ (ACL2-COUNT (CDR A)) (ACL2-COUNT B2))
            (+ (ACL2-COUNT A)
               (ACL2-COUNT (CONS B1 B2))))).

This simplifies, using the :definition ACL2-COUNT, primitive type reasoning
and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+ and
COMMUTATIVITY-OF-+, to

Subgoal 1.1''
(< (+ (ACL2-COUNT B2) (ACL2-COUNT (CDR A)))
   (+ 1 (ACL2-COUNT A)
      (ACL2-COUNT B1)
      (ACL2-COUNT B2))).

The destructor terms (CAR A) and (CDR A) can be eliminated by using
CAR-CDR-ELIM to replace A by (CONS A1 A2), generalizing (CAR A) to
A1 and (CDR A) to A2.  This produces the following two goals.

Subgoal 1.1.2
(IMPLIES (NOT (CONSP A))
         (< (+ (ACL2-COUNT B2) (ACL2-COUNT (CDR A)))
            (+ 1 (ACL2-COUNT A)
               (ACL2-COUNT B1)
               (ACL2-COUNT B2)))).

This simplifies, using the :definition FIX, the :executable-counterpart
of ACL2-COUNT, the :rewrite rules COMMUTATIVITY-OF-+, DEFAULT-CDR and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 1.1.2'
(IMPLIES (NOT (CONSP A))
         (< (ACL2-COUNT B2)
            (+ 1 (ACL2-COUNT A)
               (ACL2-COUNT B1)
               (ACL2-COUNT B2)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1.1.1
(IMPLIES (CONSP (CONS A1 A2))
         (< (+ (ACL2-COUNT B2) (ACL2-COUNT A2))
            (+ 1 (ACL2-COUNT (CONS A1 A2))
               (ACL2-COUNT B1)
               (ACL2-COUNT B2)))).

This simplifies, using the :definitions ACL2-COUNT and SYNTAXP, the
:executable-counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive
type reasoning and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
2-OF-+, COMMUTATIVITY-OF-+ and FOLD-CONSTS-IN-+, to

Subgoal 1.1.1'
(< (+ (ACL2-COUNT A2) (ACL2-COUNT B2))
   (+ 2 (ACL2-COUNT A1)
      (ACL2-COUNT A2)
      (ACL2-COUNT B1)
      (ACL2-COUNT B2))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Q.E.D.

That completes the proof of the measure theorem for SERIAL-ADDER. 
Thus, we admit this function under the principle of definition. We
observe that the type of SERIAL-ADDER is described by the theorem 
(AND (CONSP (SERIAL-ADDER A B C)) (TRUE-LISTP (SERIAL-ADDER A B C))).
We used primitive type reasoning.

Summary
Form:  ( DEFUN SERIAL-ADDER ...)
Rules: ((:DEFINITION ACL2-COUNT)
        (:DEFINITION E0-ORD-<)
        (:DEFINITION E0-ORDINALP)
        (:DEFINITION ENDP)
        (:DEFINITION FIX)
        (:DEFINITION SYNTAXP)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ACL2-COUNT)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART IF)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE DEFAULT-CDR)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION ACL2-COUNT))
Warnings:  None
Time:  0.63 seconds (prove: 0.54, print: 0.06, other: 0.03)
 SERIAL-ADDER
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)

Now we run a few tests. The two vectors above stand for the numbers 3 and 5. The final nil is the intput carry flag, which is off. So the answer will be 8, in binary.


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)
(NIL NIL NIL T)
ACL2 !>


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)
(NIL NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                     t)


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)
(NIL NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                     t)
(T NIL NIL T)
ACL2 !>


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)
(NIL NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                     t)
(T NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '()
                     t)


[top] [prev] [next]

ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                      nil)
(NIL NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '(t nil t)
                     t)
(T NIL NIL T)
ACL2 !>(serial-adder '(t t nil)
                     '()
                     t)
(NIL NIL T NIL)
ACL2 !>

Note that if one argument is empty and the carry flag is on, the adder is just an incrementor.


[top] [prev] [next]

ACL2 !>(defconst *a*
        '(t nil nil t t t t t nil t t t nil t nil t
          nil t nil t t t t t t t t t t t nil nil
          nil nil nil t t t t t nil t t t nil t nil t
          t t nil t t t t t nil t nil t t nil nil t
          t nil nil t t t t t nil t nil t nil t t t
          nil t nil t t t t t nil t nil t nil t nil nil
          t nil nil t t t t t t t t t t t nil nil
          nil nil nil t t t t t t t t t nil t nil t
          nil nil nil nil t t t t t t nil t nil nil t t))

This command defines *a* as a constant. It is some relatively long bit vector.


[top] [prev] [next]

ACL2 !>(defconst *a*
        '(t nil nil t t t t t nil t t t nil t nil t
          nil t nil t t t t t t t t t t t nil nil
          nil nil nil t t t t t nil t t t nil t nil t
          t t nil t t t t t nil t nil t t nil nil t
          t nil nil t t t t t nil t nil t nil t t t
          nil t nil t t t t t nil t nil t nil t nil nil
          t nil nil t t t t t t t t t t t nil nil
          nil nil nil t t t t t t t t t nil t nil t
          nil nil nil nil t t t t t t nil t nil nil t t))

Summary
Form:  ( DEFCONST *A* ...)
Rules: NIL
Warnings:  None
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 *A*
ACL2 !>


[top] [prev] [next]

ACL2 !>(defconst *b*
        '(t t t t t t t t t t nil t nil t nil t
          t nil t t t t t t t t t t nil nil nil nil
          nil nil nil t t t t t nil t nil t t t t t
          t nil nil t t t t t t t t t t nil t nil
          t nil t nil t t t t t t t t t nil nil nil
          nil t t t t t t t nil t nil t t t t nil
          t nil t nil t t t t nil t nil t t nil nil t
          nil nil nil t t t t t nil t nil t nil t nil nil
          nil t t t t t t t t t t t nil t nil t))

We similiarly define the constant *b*.


[top] [prev] [next]

ACL2 !>(defconst *b*
        '(t t t t t t t t t t nil t nil t nil t
          t nil t t t t t t t t t t nil nil nil nil
          nil nil nil t t t t t nil t nil t t t t t
          t nil nil t t t t t t t t t t nil t nil
          t nil t nil t t t t t t t t t nil nil nil
          nil t t t t t t t nil t nil t t t t nil
          t nil t nil t t t t nil t nil t t nil nil t
          nil nil nil t t t t t nil t nil t nil t nil nil
          nil t t t t t t t t t t t nil t nil t))

Summary
Form:  ( DEFCONST *B* ...)
Rules: NIL
Warnings:  None
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 *B*
ACL2 !>


[top] [prev] [next]

ACL2 !>(serial-adder *a* *b* nil)

And now we do the obvious: we use serial-adder to add these two long bit vectors.


[top] [prev] [next]

ACL2 !>(serial-adder *a* *b* nil)
(NIL NIL
     NIL T T T T T NIL T NIL T T NIL T NIL
     NIL NIL NIL T T T T T T T T T NIL NIL
     T NIL NIL NIL NIL NIL T T T T T NIL NIL
     T NIL T NIL T T NIL T NIL T T T T NIL T
     NIL T T T T T NIL T T T NIL T T T NIL T
     NIL T NIL NIL NIL NIL T NIL NIL T T T T
     T T NIL T NIL NIL T NIL T NIL T T T NIL
     T T T NIL T NIL T T NIL T T NIL NIL NIL
     NIL T T T T NIL T NIL T T NIL T T NIL
     T T T NIL T T T T T NIL T T T T NIL T)
ACL2 !>

Is that the correct answer? It's pretty hard to figure out.


[top] [prev] [next]

ACL2 !>(defun n (v)
        (cond ((endp v) 0)
              ((car v) (+ 1 (* 2 (n (cdr v)))))
              (t (* 2 (n (cdr v))))))

So we define the function that maps a bit vector to the natural number it denotes. This function should make sense to you if you read it: The empty vector denotes 0. A vector starting with t denotes the number one more than twice the denotation of the rest of the vector. A vector starting with nil denotes the number twice the denotation of the rest of the vector. We could have accumulated powers of 2, but multiplying the denotation by 2 is simpler.


[top] [prev] [next]

ACL2 !>(defun n (v)
        (cond ((endp v) 0)
              ((car v) (+ 1 (* 2 (n (cdr v)))))
              (t (* 2 (n (cdr v))))))

The admission of N is trivial, using the relation E0-ORD-< (which is
known to be well-founded on the domain recognized by E0-ORDINALP) and
the measure (ACL2-COUNT V).  We observe that the type of N is described
by the theorem (AND (INTEGERP (N V)) (<= 0 (N V))).  We used primitive
type reasoning.

Summary
Form:  ( DEFUN N ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 N
ACL2 !>


[top] [prev] [next]

ACL2 !>(n '(t t nil))


[top] [prev] [next]

ACL2 !>(n '(t t nil))
3
ACL2 !>

Just what you expected, we hope!


[top] [prev] [next]

ACL2 !>(n *a*)

So now we can see what number is denoted by *a*. Then we'll do the same for *b* and then we'll add them two ways: first by adding the numbers denoted and second by adding the vectors with the serial adder and converting the result to a natural. We ought to get the same answer.


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>

A pretty big natural number.


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)
15331138877664345459150421522004660157524991
ACL2 !>


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)
15331138877664345459150421522004660157524991
ACL2 !>(+ (n *a*) (n *b*))


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)
15331138877664345459150421522004660157524991
ACL2 !>(+ (n *a*) (n *b*))
33096834593759116955768905689498635942255352
ACL2 !>


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)
15331138877664345459150421522004660157524991
ACL2 !>(+ (n *a*) (n *b*))
33096834593759116955768905689498635942255352
ACL2 !>(n (serial-adder *a* *b* nil))


[top] [prev] [next]

ACL2 !>(n *a*)
17765695716094771496618484167493975784730361
ACL2 !>(n *b*)
15331138877664345459150421522004660157524991
ACL2 !>(+ (n *a*) (n *b*))
33096834593759116955768905689498635942255352
ACL2 !>(n (serial-adder *a* *b* nil))
33096834593759116955768905689498635942255352
ACL2 !>

Pretty cool. We get the same answer both ways. That's just one test. But it is suggestive of a theorem we'd like to prove.


[top] [prev] [next]

ACL2 !>(defthm serial-adder-correct
         (equal (n (serial-adder x y c))
                (+ (n x) (n y) (if c 1 0))))


[top] [prev] [next]

ACL2 !>(defthm serial-adder-correct
         (equal (n (serial-adder x y c))
                (+ (n x) (n y) (if c 1 0))))

This proof is going to fail, though you can't tell yet. You may scroll through it or you can skip to the first sign of failure.


This simplifies, using trivial observations, to the following two conjectures.

Subgoal 2
(IMPLIES C
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) 1))).

This simplifies, using the :rewrite rules COMMUTATIVITY-2-OF-+ and
COMMUTATIVITY-OF-+, to

Subgoal 2'
(IMPLIES C
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ 1 (N X) (N Y)))).

Name the formula above *1.

Subgoal 1
(IMPLIES (NOT C)
         (EQUAL (N (SERIAL-ADDER X Y NIL))
                (+ (N X) (N Y) 0))).

This simplifies, using the :definition FIX, the :rewrite rules COMMUTATIVITY-
OF-+ and UNICITY-OF-0 and the :type-prescription rule N, to

Subgoal 1'
(EQUAL (N (SERIAL-ADDER X Y NIL))
       (+ (N X) (N Y))).

Normally we would attempt to prove this formula by induction.  However,
we prefer in this instance to focus on the original input conjecture
rather than this simplified special case.  We therefore abandon our
previous work on this conjecture and reassign the name *1 to the original
conjecture.  (See :DOC otf-flg.)

Perhaps we can prove *1 by induction.  Three induction schemes are
suggested by this conjecture.  These merge into one derived induction
scheme.  

We will induct according to a scheme suggested by (N Y), but modified
to accommodate (N X) and (SERIAL-ADDER X Y C).  If we let  (:P C X Y)
denote *1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP Y))
                   (NOT (CAR Y))
                   (:P (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                       (CDR X)
                       (CDR Y)))
              (:P C X Y))
     (IMPLIES (AND (NOT (ENDP Y))
                   (CAR Y)
                   (:P (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                       (CDR X)
                       (CDR Y)))
              (:P C X Y))
     (IMPLIES (ENDP Y) (:P C X Y))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT Y) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  Note, however, that the unmeasured variables C and
X are being instantiated.  When applied to the goal at hand the above
induction scheme produces the following three nontautological subgoals.

Subgoal *1/3
(IMPLIES
     (AND (NOT (ENDP Y))
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

As we said, this proof is going to fail, though you can't tell yet. You may continue to scroll through it or you can skip to the first sign of failure.


Subgoal *1/3'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, MV-NTH,
N, SERIAL-ADDER and XOR, the :executable-counterparts of BINARY-+,
CONS, MV-NTH, XOR and ZP, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-OF-+ and UNICITY-
OF-0 and the :type-prescription rule N, to the following nine conjectures.

Subgoal *1/3.9
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 0))
          (CONSP X)
          C)
     (EQUAL (N (CONS T (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y)))
               (* 2 (N (CDR X)))))).

This simplifies, using the :definitions FIX and N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, LEFT-CANCELLATION-
FOR-+ and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-
ADDER, to

Subgoal *1/3.9'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          C)
     (EQUAL (* 2
               (N (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
            (+ (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ and XOR, the :executable-counterparts of CONS, MV-NTH and XOR,
primitive type reasoning and the :rewrite rule DISTRIBUTIVITY.

Subgoal *1/3.8
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 0))
          (NOT (CONSP X))
          C)
     (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL and FIX, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, LEFT-CANCELLATION-FOR-
*, LEFT-CANCELLATION-FOR-+ and UNICITY-OF-0 and the :type-prescription
rules N and SERIAL-ADDER, to

Subgoal *1/3.8'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y))))
          (NOT (CONSP X))
          C)
     (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
            (N (CDR Y)))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ and XOR, the :executable-counterparts of CONS, MV-NTH, N
and XOR, the :rewrite rules DEFAULT-CAR, DEFAULT-CDR and UNICITY-OF-
0 and the :type-prescription rule N.

Are you tired yet? It takes the system about 3 seconds to run this proof attempt out to its bitter end and fail. So if you were driving the theorem prover you would already know the proof had failed and you begin looking for the reason. Our book, Computer-Aided Reasoning: An Approach explains ``The Method'' we use to identify the reason a proof fails. You may continue to scroll through this proof attempt or you can skip to the first sign of failure.


Subgoal *1/3.7
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
          (+ 0 (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/3.7'
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
          (FIX (+ (* 2 (N (CDR Y)))
                  (* 2 (N (CDR X))))))).

But simplification reduces this to T, using the :definitions FIX and
N, the :executable-counterparts of FULL-ADDER and MV-NTH, primitive
type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+, DISTRIBUTIVITY and UNICITY-OF-0 and the :type-prescription rules
N and SERIAL-ADDER.

Subgoal *1/3.6
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 0 (* 2 (N (CDR Y))) 0))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/3.6'
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) NIL)))
          (FIX (+ (* 2 (N (CDR Y))) 0)))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL, FIX, FULL-ADDER and MV-NTH, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-
CAR, DEFAULT-CDR, LEFT-CANCELLATION-FOR-* and UNICITY-OF-0 and the
:type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/3.6''
(IMPLIES (AND (CONSP Y)
              (NOT (CAR Y))
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/3.5
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X))
     (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 1 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

All the goals so far have succeeded! But we know the proof fails so something interesting happens below. You may to scroll through the proof attempt or you can skip to the first sign of failure.


Subgoal *1/3.5'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X))
     (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-*, BINARY-
+ and ZP, primitive type reasoning and the :rewrite rules CDR-CONS
and DISTRIBUTIVITY.

Subgoal *1/3.4
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X)))
     (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y))) 0))).

But simplification reduces this to T, using trivial observations.

Subgoal *1/3.3
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX, N and SERIAL-ADDER, the
:executable-counterparts of EQUAL, FIX, FULL-ADDER and MV-NTH, primitive
type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+, DEFAULT-CAR, DEFAULT-CDR, LEFT-CANCELLATION-FOR-* and UNICITY-
OF-0 and the :type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/3.3'
(IMPLIES (AND (CONSP Y)
              (NOT (CAR Y))
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/3.2
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (CAR X))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y)))
             1 (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, N, SERIAL-ADDER and XOR, the :executable-counterparts of
CONS, MV-NTH and XOR, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-OF-+, DISTRIBUTIVITY
and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-ADDER.

Subgoal *1/3.1
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT (CAR X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, N
and SERIAL-ADDER, the :executable-counterparts of FULL-ADDER and MV-
NTH, primitive type reasoning, the :rewrite rules CAR-CONS, CDR-CONS,
COMMUTATIVITY-OF-+, DISTRIBUTIVITY and UNICITY-OF-0 and the :type-
prescription rules N and SERIAL-ADDER.

Subgoal *1/2
(IMPLIES
     (AND (NOT (ENDP Y))
          (CAR Y)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

Still successful so far. You may continue to scroll or you can skip to the first sign of failure.


This simplifies, using the :definitions FULL-ADDER, MAJ, MV-NTH, N,
SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts of BINARY-
+, CAR, CONSP, EQ, IF, XOR and ZP, primitive type reasoning and the
:rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+, to the following nine conjectures.

Subgoal *1/2.9
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          C)
     (EQUAL (N (CONS T
                     (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
            (+ 1 1 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

Subgoal *1/2.9'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          C)
     (EQUAL (+ 1
               (* 2
                  (N (SERIAL-ADDER (CDR X)
                                   (CDR Y)
                                   (CAR Y)))))
            (+ 3 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, SYNTAXP and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning and
the :rewrite rules CDR-CONS, DISTRIBUTIVITY and FOLD-CONSTS-IN-+.

Subgoal *1/2.8
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X))
          C)
     (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 1 1 (* 2 (N (CDR Y))) 0))).

But simplification reduces this to T, using trivial observations.

Subgoal *1/2.7
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL
                   (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
          (+ 1 0 (* 2 (N (CDR Y)))
             1 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Still successful. You may continue to scroll or you can skip to the first sign of failure.


Subgoal *1/2.7'
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL
                   (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
          (+ 1
             (FIX (+ (* 2 (N (CDR Y)))
                     1 (* 2 (N (CDR X)))))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, MV-NTH, N, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+, DISTRIBUTIVITY and FOLD-CONSTS-IN-+ and the :type-prescription
rules N and SERIAL-ADDER.

Subgoal *1/2.6
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 1 0 (* 2 (N (CDR Y))) 0))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/2.6'
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 1 (FIX (+ (* 2 (N (CDR Y))) 0))))).

But we reduce the conjecture to T, by case analysis.

Subgoal *1/2.5
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (NOT (CAR X))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ 1 (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, N, SERIAL-ADDER and XOR, the :executable-counterparts of
CONS, MV-NTH and XOR, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DISTRIBUTIVITY and UNICITY-
OF-0 and the :type-prescription rules N and SERIAL-ADDER.

Subgoal *1/2.4
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (NOT (CAR X))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ 1 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, N, SERIAL-
ADDER and XOR, the :executable-counterparts of CONS, EQUAL, FIX, MV-
NTH and XOR, primitive type reasoning, the :rewrite rules CAR-CONS,
CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-CAR, DEFAULT-CDR, LEFT-CANCELLATION-
FOR-*, LEFT-CANCELLATION-FOR-+ and UNICITY-OF-0 and the :type-prescription
rules N and SERIAL-ADDER, to

Subgoal *1/2.4'
(IMPLIES (AND (CONSP Y)
              (CAR Y)
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/2.3
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X)))
     (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX and N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-
ADDER, to

Subgoal *1/2.3'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (NOT (CONSP X)))
     (EQUAL (* 2 (N (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, N, XOR and ZP, primitive type reasoning, the :rewrite
rules CDR-CONS, DEFAULT-CAR, DEFAULT-CDR, DISTRIBUTIVITY and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/2.2
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          (CAR X))
     (EQUAL (N (CONS T
                     (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
            (+ 2 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

Still successful. You may continue to scroll or you can skip to the first sign of failure.


This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

Subgoal *1/2.2'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          (CAR X))
     (EQUAL (+ 1
               (* 2
                  (N (SERIAL-ADDER (CDR X)
                                   (CDR Y)
                                   (CAR Y)))))
            (+ 3 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, SYNTAXP and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning and
the :rewrite rules CDR-CONS, DISTRIBUTIVITY and FOLD-CONSTS-IN-+.

Subgoal *1/2.1
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          (NOT (CAR X)))
     (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y)))
               (* 2 (N (CDR X)))))).

This simplifies, using the :definition N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+ and COMMUTATIVITY-
OF-+ and the :type-prescription rule SERIAL-ADDER, to

Subgoal *1/2.1'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          (NOT (CAR X)))
     (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-*, BINARY-
+, XOR and ZP, primitive type reasoning and the :rewrite rules CDR-
CONS and DISTRIBUTIVITY.

Subgoal *1/1
(IMPLIES (ENDP Y)
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP Y))
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) (IF C 1 0)))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, MV-NTH,
N, SERIAL-ADDER and XOR, the :executable-counterparts of BINARY-+,
CONS, EQUAL, N and ZP, primitive type reasoning and the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-CAR, DEFAULT-CDR and
UNICITY-OF-0, to the following five conjectures.

Subgoal *1/1.5
(IMPLIES (AND (NOT (CONSP Y)) (NOT (CONSP X)) C)
         (EQUAL (N (LIST C)) (+ 1 0))).

By the :executable-counterpart of BINARY-+ we reduce the conjecture
to

Subgoal *1/1.5'
(IMPLIES (AND (NOT (CONSP Y)) (NOT (CONSP X)) C)
         (EQUAL (N (LIST C)) 1)).

But simplification reduces this to T, using the :definition N, the
:executable-counterparts of BINARY-*, BINARY-+, EQUAL and N, primitive
type reasoning and the :rewrite rules CAR-CONS and CDR-CONS.

Subgoal *1/1.4
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) T)
                         (SERIAL-ADDER (CDR X) NIL C)))
                (+ 1 1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N, SYNTAXP and XOR, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS and FOLD-CONSTS-IN-+ and the
:type-prescription rule SERIAL-ADDER, to

Subgoal *1/1.4'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (CAR X))
         (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) NIL C)))
                (+ 2 (* 2 (N (CDR X)))))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/1.4''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (NOT (CONSP Y))
              C X1)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

This simplifies, using primitive type reasoning, to

Subgoal *1/1.4'''
(IMPLIES (AND (NOT (CONSP Y)) C X1)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

This simplifies, using trivial observations, to

Subgoal *1/1.4'4'
(IMPLIES (AND (NOT (CONSP Y)) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

We suspect that the term (NOT (CONSP Y)) is irrelevant to the truth
of this conjecture and throw it out.  We will thus try to prove

This proof attempt is going to fail. The goal below is indicative of the reason. Note that it requires the knowledge that serial-adder is an incrementer when one argument is empty and the carry in flag is non-nil. But the goal below is not general enough to be proved by induction given ACL2's current arithmetic data base because it talks about ``twice the value denoted'' rather than ``the value denoted.'' (With suitable arithmetic lemmas in the data base, ACL2 could simplify this to the required general goal.) The analogous goal, in which the input carry flag is off, will also arise below and is actually useful in proving the other case.

[top]: back to beginning of demo
[prev]: back to previous command
[restart proof attempt]: back to beginning of this proof attempt
[finish proof attempt]: forward to end of this proof attempt
[next]: forward to the command we use to ``fix'' this proof attempt

Subgoal *1/1.4'5'
(IMPLIES C
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

Name the formula above *1.1.

Subgoal *1/1.3
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 0 1 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/1.3'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (FIX (+ 1 (* 2 (N (CDR X))))))).

This simplifies, using the :definitions FIX, N and XOR, the :executable-
counterparts of EQUAL and FIX, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, LEFT-CANCELLATION-FOR-* and LEFT-CANCELLATION-
FOR-+ and the :type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/1.3''
(IMPLIES (AND (NOT (CONSP Y)) (CONSP X) (CAR X))
         (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                (N (CDR X)))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/1.3'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (NOT (CONSP Y))
              X1)
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

This simplifies, using primitive type reasoning, to

Subgoal *1/1.3'4'
(IMPLIES (AND (NOT (CONSP Y)) X1)
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

This simplifies, using trivial observations, to

Subgoal *1/1.3'5'
(IMPLIES (NOT (CONSP Y))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

We suspect that the term (NOT (CONSP Y)) is irrelevant to the truth
of this conjecture and throw it out.  We will thus try to prove

Subgoal *1/1.3'6'
(EQUAL (N (SERIAL-ADDER X2 NIL NIL))
       (N X2)).

Name the formula above *1.2.

Subgoal *1/1.2
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) T)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL, FIX and XOR, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, LEFT-CANCELLATION-FOR-* and LEFT-CANCELLATION-
FOR-+ and the :type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/1.2'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT (CAR X)))
         (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                (N (CDR X)))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/1.2''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (NOT (CONSP Y))
              (NOT X1))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

This simplifies, using primitive type reasoning, to

Subgoal *1/1.2'''
(IMPLIES (NOT (CONSP Y))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

We suspect that the term (NOT (CONSP Y)) is irrelevant to the truth
of this conjecture and throw it out.  We will thus try to prove

Subgoal *1/1.2'4'
(EQUAL (N (SERIAL-ADDER X2 NIL NIL))
       (N X2)).

Name the formula above *1.3.

Subgoal *1/1.1
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 0 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/1.1'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (FIX (* 2 (N (CDR X)))))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL, FIX and XOR, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS and LEFT-CANCELLATION-FOR-* and the :type-
prescription rules N and SERIAL-ADDER, to

Subgoal *1/1.1''
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT (CAR X)))
         (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                (N (CDR X)))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/1.1'''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (NOT (CONSP Y))
              (NOT X1))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

This simplifies, using primitive type reasoning, to

Subgoal *1/1.1'4'
(IMPLIES (NOT (CONSP Y))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

We suspect that the term (NOT (CONSP Y)) is irrelevant to the truth
of this conjecture and throw it out.  We will thus try to prove

Subgoal *1/1.1'5'
(EQUAL (N (SERIAL-ADDER X2 NIL NIL))
       (N X2)).

Name the formula above *1.4.


But this formula is subsumed by *1.3, which we'll try to prove later.
We therefore regard *1.4 as proved (pending the proof of the more general
*1.3).

We next consider *1.3, which is

(EQUAL (N (SERIAL-ADDER X2 NIL NIL))
       (N X2)).

But this formula is subsumed by *1.2, which we'll try to prove later.
We therefore regard *1.3 as proved (pending the proof of the more general
*1.2).

We next consider *1.2, which is

(EQUAL (N (SERIAL-ADDER X2 NIL NIL))
       (N X2)).

Perhaps we can prove *1.2 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (N X2).  If we let
 (:P X2) denote *1.2 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X2))
                   (NOT (CAR X2))
                   (:P (CDR X2)))
              (:P X2))
     (IMPLIES (AND (NOT (ENDP X2))
                   (CAR X2)
                   (:P (CDR X2)))
              (:P X2))
     (IMPLIES (ENDP X2) (:P X2))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT X2) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following three nontautological subgoals.

Subgoal *1.2/3
(IMPLIES (AND (NOT (ENDP X2))
              (NOT (CAR X2))
              (EQUAL (N (SERIAL-ADDER (CDR X2) NIL NIL))
                     (N (CDR X2))))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.2/3'
(IMPLIES (AND (CONSP X2)
              (NOT (CAR X2))
              (EQUAL (N (SERIAL-ADDER (CDR X2) NIL NIL))
                     (N (CDR X2))))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER, the :executable-counterparts of CAR, CDR, FULL-ADDER
and MV-NTH, primitive type reasoning, the :rewrite rules CAR-CONS and
CDR-CONS and the :type-prescription rule SERIAL-ADDER.

Subgoal *1.2/2
(IMPLIES (AND (NOT (ENDP X2))
              (CAR X2)
              (EQUAL (N (SERIAL-ADDER (CDR X2) NIL NIL))
                     (N (CDR X2))))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.2/2'
(IMPLIES (AND (CONSP X2)
              (CAR X2)
              (EQUAL (N (SERIAL-ADDER (CDR X2) NIL NIL))
                     (N (CDR X2))))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, N, SERIAL-ADDER and XOR, the :executable-counterparts of CAR,
CDR, CONS, MV-NTH and XOR, primitive type reasoning, the :rewrite rules
CAR-CONS and CDR-CONS and the :type-prescription rule SERIAL-ADDER.

Subgoal *1.2/1
(IMPLIES (ENDP X2)
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.2/1'
(IMPLIES (NOT (CONSP X2))
         (EQUAL (N (SERIAL-ADDER X2 NIL NIL))
                (N X2))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER and the :executable-counterparts of CONS, CONSP, EQUAL
and N.

That completes the proof of *1.2.

We therefore turn our attention to *1.1, which is

(IMPLIES C
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

Perhaps we can prove *1.1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (N X2).  If we let
 (:P C X2) denote *1.1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X2))
                   (NOT (CAR X2))
                   (:P C (CDR X2)))
              (:P C X2))
     (IMPLIES (AND (NOT (ENDP X2))
                   (CAR X2)
                   (:P C (CDR X2)))
              (:P C X2))
     (IMPLIES (ENDP X2) (:P C X2))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT X2) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following three nontautological subgoals.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP X2))
              (NOT (CAR X2))
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP X2)
              (NOT (CAR X2))
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, N, SERIAL-
ADDER, SYNTAXP and XOR, the :executable-counterparts of BINARY-*, CAR,
CDR, CONS, CONSP, EQ, EQUAL, FIX, IF, MV-NTH and XOR, primitive type
reasoning, the :rewrite rules CAR-CONS, CDR-CONS, DISTRIBUTIVITY, FOLD-
CONSTS-IN-*, LEFT-CANCELLATION-FOR-* and LEFT-CANCELLATION-FOR-+ and
the :type-prescription rules N and SERIAL-ADDER, to

Subgoal *1.1/3''
(IMPLIES (AND (CONSP X2)
              (NOT (CAR X2))
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (N (SERIAL-ADDER (CDR X2) NIL NIL))
                (N (CDR X2)))).

The destructor terms (CAR X2) and (CDR X2) can be eliminated by using
CAR-CDR-ELIM to replace X2 by (CONS X3 X4), generalizing (CAR X2) to
X3 and (CDR X2) to X4.  This produces the following goal.

Subgoal *1.1/3'''
(IMPLIES (AND (CONSP (CONS X3 X4))
              (NOT X3)
              (EQUAL (* 2 (N (SERIAL-ADDER X4 NIL C)))
                     (+ 2 (* 2 (N X4))))
              C)
         (EQUAL (N (SERIAL-ADDER X4 NIL NIL))
                (N X4))).

This simplifies, using primitive type reasoning, to

Subgoal *1.1/3'4'
(IMPLIES (AND (EQUAL (* 2 (N (SERIAL-ADDER X4 NIL C)))
                     (+ 2 (* 2 (N X4))))
              C)
         (EQUAL (N (SERIAL-ADDER X4 NIL NIL))
                (N X4))).

We generalize this conjecture, replacing (N X4) by I and restricting
the type of the new variable I to be that of the term it replaces,
as established by N.  This produces

Subgoal *1.1/3'5'
(IMPLIES (AND (INTEGERP I)
              (<= 0 I)
              (EQUAL (* 2 (N (SERIAL-ADDER X4 NIL C)))
                     (+ 2 (* 2 I)))
              C)
         (EQUAL (N (SERIAL-ADDER X4 NIL NIL))
                I)).

Name the formula above *1.1.1.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP X2))
              (CAR X2)
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP X2)
              (CAR X2)
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, N, SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, BINARY-+, CAR, CDR, CONSP, EQ, IF and ZP, primitive type
reasoning, the :rewrite rules CAR-CONS, CDR-CONS, DISTRIBUTIVITY, FOLD-
CONSTS-IN-* and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-
ADDER.

Subgoal *1.1/1
(IMPLIES (AND (ENDP X2) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (AND (NOT (CONSP X2)) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER, the :executable-counterparts of BINARY-*, BINARY-+, CONSP,
EQUAL and N, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

So we now return to *1.1.1, which is

(IMPLIES (AND (INTEGERP I)
              (<= 0 I)
              (EQUAL (* 2 (N (SERIAL-ADDER X4 NIL C)))
                     (+ 2 (* 2 I)))
              C)
         (EQUAL (N (SERIAL-ADDER X4 NIL NIL))
                I)).

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

Summary
Form:  ( DEFTHM SERIAL-ADDER-CORRECT ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION FIX)
        (:DEFINITION FULL-ADDER)
        (:DEFINITION MAJ)
        (:DEFINITION MV-NTH)
        (:DEFINITION N)
        (:DEFINITION NOT)
        (:DEFINITION SERIAL-ADDER)
        (:DEFINITION SYNTAXP)
        (:DEFINITION XOR)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART BINARY-*)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART FIX)
        (:EXECUTABLE-COUNTERPART FULL-ADDER)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART MV-NTH)
        (:EXECUTABLE-COUNTERPART N)
        (:EXECUTABLE-COUNTERPART XOR)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE DEFAULT-CAR)
        (:REWRITE DEFAULT-CDR)
        (:REWRITE DISTRIBUTIVITY)
        (:REWRITE FOLD-CONSTS-IN-*)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE LEFT-CANCELLATION-FOR-*)
        (:REWRITE LEFT-CANCELLATION-FOR-+)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION N)
        (:TYPE-PRESCRIPTION SERIAL-ADDER))
Warnings:  None
Time:  2.59 seconds (prove: 2.09, print: 0.49, other: 0.01)

******** FAILED ********  See :DOC failure  ******** FAILED ********
ACL2 !>

This proof attempt failed. In a valiant struggle, ACL2 proved about 40 subgoals, including the inductively proved fact that serial-adder is a no-op (vis-a-vis the natural interpretation of its answer) when the last two arguments are nil. Only one subgoal remained to be proved and ACL2 failed to find a general enough form of it to go through induction. It tried induction anyway and the proof attempt produced a subgoal which ACL2 could not further manipulate. So it quit.

The informed user of ACL2 can use ``The Method'' described in Computer-Aided Reasoning: An Approach to identify Subgoal *1/1.4'5' as the problem. The user can ``fix'' the problem by asking ACL2 to prove a certain lemma before asking it to prove this theorem again. We state the lemma in the next command.

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm serial-adder-special-case
         (and (equal (n (serial-adder x nil t)) (+ 1 (n x)))
              (equal (n (serial-adder x nil nil)) (n x))))

We ask ACL2 prove two important facts about the serial adder: when one argument is empty serial-adder is either an incrementor or a no-op, depending on the input carry. We could prove these two facts separately, if we proved the second one first so it was available during the proof of the first one. But we bundle them together here just to keep the presentation simpler. The proof is uneventful so after you see its beginning you might want to proceed to the next command.


[top] [prev] [next]

ACL2 !>(defthm serial-adder-special-case
         (and (equal (n (serial-adder x nil t)) (+ 1 (n x)))
              (equal (n (serial-adder x nil nil)) (n x))))

By case analysis we reduce the conjecture to the following two conjectures.

Subgoal 2
(EQUAL (N (SERIAL-ADDER X NIL T))
       (+ 1 (N X))).

Name the formula above *1.

Subgoal 1
(EQUAL (N (SERIAL-ADDER X NIL NIL))
       (N X)).

Normally we would attempt to prove this formula by induction.  However,
we prefer in this instance to focus on the original input conjecture
rather than this simplified special case.  We therefore abandon our
previous work on this conjecture and reassign the name *1 to the original
conjecture.  (See :DOC otf-flg.)

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 (N X).  If we let
 (:P X) denote *1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X))
                   (NOT (CAR X))
                   (:P (CDR X)))
              (:P X))
     (IMPLIES (AND (NOT (ENDP X))
                   (CAR X)
                   (:P (CDR X)))
              (:P X))
     (IMPLIES (ENDP X) (:P X))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following three nontautological subgoals.

Subgoal *1/3
(IMPLIES (AND (NOT (ENDP X))
              (NOT (CAR X))
              (AND (EQUAL (N (SERIAL-ADDER (CDR X) NIL T))
                          (+ 1 (N (CDR X))))
                   (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                          (N (CDR X)))))
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/3'
(IMPLIES (AND (CONSP X)
              (NOT (CAR X))
              (EQUAL (N (SERIAL-ADDER (CDR X) NIL T))
                     (+ 1 (N (CDR X))))
              (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                     (N (CDR X))))
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER, the :executable-counterparts of CAR, CDR, FULL-ADDER
and MV-NTH, primitive type reasoning, the :rewrite rules CAR-CONS and
CDR-CONS and the :type-prescription rule SERIAL-ADDER.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (CAR X)
              (AND (EQUAL (N (SERIAL-ADDER (CDR X) NIL T))
                          (+ 1 (N (CDR X))))
                   (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                          (N (CDR X)))))
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (CAR X)
              (EQUAL (N (SERIAL-ADDER (CDR X) NIL T))
                     (+ 1 (N (CDR X))))
              (EQUAL (N (SERIAL-ADDER (CDR X) NIL NIL))
                     (N (CDR X))))
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, N, SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, BINARY-+, CAR, CDR, CONS, CONSP, EQ, IF, MV-NTH and XOR,
primitive type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, DISTRIBUTIVIT\
Y and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER.

Subgoal *1/1
(IMPLIES (ENDP X)
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (AND (EQUAL (N (SERIAL-ADDER X NIL T))
                     (+ 1 (N X)))
              (EQUAL (N (SERIAL-ADDER X NIL NIL))
                     (N X)))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER and the :executable-counterparts of BINARY-+, CONS, CONSP,
EQUAL and N.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM SERIAL-ADDER-SPECIAL-CASE ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION FULL-ADDER)
        (:DEFINITION MAJ)
        (:DEFINITION N)
        (:DEFINITION NOT)
        (:DEFINITION SERIAL-ADDER)
        (:DEFINITION SYNTAXP)
        (:DEFINITION XOR)
        (:EXECUTABLE-COUNTERPART BINARY-*)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART FULL-ADDER)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART MV-NTH)
        (:EXECUTABLE-COUNTERPART N)
        (:EXECUTABLE-COUNTERPART XOR)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE DISTRIBUTIVITY)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:TYPE-PRESCRIPTION SERIAL-ADDER))
Warnings:  None
Time:  0.38 seconds (prove: 0.31, print: 0.04, other: 0.03)
 SERIAL-ADDER-SPECIAL-CASE
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm serial-adder-correct
         (equal (n (serial-adder x y c))
                (+ (n x) (n y) (if c 1 0))))

Here is the main theorem about the serial adder, again. This time the proof is uneventful, since we have proved the key lemma about the special cases.


[top] [prev] [next]

ACL2 !>(defthm serial-adder-correct
         (equal (n (serial-adder x y c))
                (+ (n x) (n y) (if c 1 0))))

ACL2 Warning [Subsume] in ( DEFTHM SERIAL-ADDER-CORRECT ...):  The
newly proposed :REWRITE rule SERIAL-ADDER-CORRECT probably subsumes
the previously added :REWRITE rules SERIAL-ADDER-SPECIAL-CASE and SERIAL-
ADDER-SPECIAL-CASE, in the sense that SERIAL-ADDER-CORRECT will now
probably be applied whenever the old rules would have been.


This simplifies, using trivial observations, to the following two conjectures.

Subgoal 2
(IMPLIES C
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) 1))).

This simplifies, using the :rewrite rules COMMUTATIVITY-2-OF-+ and
COMMUTATIVITY-OF-+, to

Subgoal 2'
(IMPLIES C
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ 1 (N X) (N Y)))).

Name the formula above *1.

Subgoal 1
(IMPLIES (NOT C)
         (EQUAL (N (SERIAL-ADDER X Y NIL))
                (+ (N X) (N Y) 0))).

This simplifies, using the :definition FIX, the :rewrite rules COMMUTATIVITY-
OF-+ and UNICITY-OF-0 and the :type-prescription rule N, to

Subgoal 1'
(EQUAL (N (SERIAL-ADDER X Y NIL))
       (+ (N X) (N Y))).

Normally we would attempt to prove this formula by induction.  However,
we prefer in this instance to focus on the original input conjecture
rather than this simplified special case.  We therefore abandon our
previous work on this conjecture and reassign the name *1 to the original
conjecture.  (See :DOC otf-flg.)

Perhaps we can prove *1 by induction.  Three induction schemes are
suggested by this conjecture.  These merge into one derived induction
scheme.  

We will induct according to a scheme suggested by (N Y), but modified
to accommodate (N X) and (SERIAL-ADDER X Y C).  If we let  (:P C X Y)
denote *1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP Y))
                   (NOT (CAR Y))
                   (:P (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                       (CDR X)
                       (CDR Y)))
              (:P C X Y))
     (IMPLIES (AND (NOT (ENDP Y))
                   (CAR Y)
                   (:P (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                       (CDR X)
                       (CDR Y)))
              (:P C X Y))
     (IMPLIES (ENDP Y) (:P C X Y))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT Y) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  Note, however, that the unmeasured variables C and
X are being instantiated.  When applied to the goal at hand the above
induction scheme produces the following three nontautological subgoals.

Subgoal *1/3
(IMPLIES
     (AND (NOT (ENDP Y))
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/3'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, MV-NTH,
N, SERIAL-ADDER and XOR, the :executable-counterparts of BINARY-+,
CONS, MV-NTH, XOR and ZP, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-OF-+ and UNICITY-
OF-0 and the :type-prescription rule N, to the following nine conjectures.

Subgoal *1/3.9
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 0))
          (CONSP X)
          C)
     (EQUAL (N (CONS T (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y)))
               (* 2 (N (CDR X)))))).

This simplifies, using the :definitions FIX and N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, LEFT-CANCELLATION-
FOR-+ and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-
ADDER, to

Subgoal *1/3.9'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          C)
     (EQUAL (* 2
               (N (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
            (+ (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ and XOR, the :executable-counterparts of CONS, MV-NTH and XOR,
primitive type reasoning and the :rewrite rule DISTRIBUTIVITY.

Subgoal *1/3.8
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (NOT (CAR X))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 0))
          (NOT (CONSP X))
          C)
     (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL and FIX, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, LEFT-CANCELLATION-FOR-
*, LEFT-CANCELLATION-FOR-+ and UNICITY-OF-0 and the :type-prescription
rules N and SERIAL-ADDER, to

Subgoal *1/3.8'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y))))
          (NOT (CONSP X))
          C)
     (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
            (N (CDR Y)))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ and XOR, the :executable-counterparts of CONS, MV-NTH, N
and XOR, the :rewrite rules DEFAULT-CAR, DEFAULT-CDR and UNICITY-OF-
0 and the :type-prescription rule N.

Subgoal *1/3.7
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
          (+ 0 (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/3.7'
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) NIL)))
          (FIX (+ (* 2 (N (CDR Y)))
                  (* 2 (N (CDR X))))))).

But simplification reduces this to T, using the :definitions FIX and
N, the :executable-counterparts of FULL-ADDER and MV-NTH, primitive
type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+, DISTRIBUTIVITY and UNICITY-OF-0 and the :type-prescription rules
N and SERIAL-ADDER.

Subgoal *1/3.6
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 0 (* 2 (N (CDR Y))) 0))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/3.6'
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT (CAR X))
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) NIL)))
          (FIX (+ (* 2 (N (CDR Y))) 0)))).

This simplifies, using the :definitions FIX and N, the :executable-
counterparts of EQUAL, FIX, FULL-ADDER and MV-NTH, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-
CAR, DEFAULT-CDR, LEFT-CANCELLATION-FOR-* and UNICITY-OF-0 and the
:type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/3.6''
(IMPLIES (AND (CONSP Y)
              (NOT (CAR Y))
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/3.5
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X))
     (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 1 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

Subgoal *1/3.5'
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X))
     (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-*, BINARY-
+ and ZP, primitive type reasoning and the :rewrite rules CDR-CONS
and DISTRIBUTIVITY.

Subgoal *1/3.4
(IMPLIES
     (AND (CONSP Y)
          (NOT (CAR Y))
          (CAR X)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X)))
     (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
            (+ 1 (* 2 (N (CDR Y))) 0))).

But simplification reduces this to T, using trivial observations.

Subgoal *1/3.3
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX, N and SERIAL-ADDER, the
:executable-counterparts of EQUAL, FIX, FULL-ADDER and MV-NTH, primitive
type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+, DEFAULT-CAR, DEFAULT-CDR, LEFT-CANCELLATION-FOR-* and UNICITY-
OF-0 and the :type-prescription rules N and SERIAL-ADDER, to

Subgoal *1/3.3'
(IMPLIES (AND (CONSP Y)
              (NOT (CAR Y))
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/3.2
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (CAR X))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y)))
             1 (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, N, SERIAL-ADDER and XOR, the :executable-counterparts of
CONS, MV-NTH and XOR, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-OF-+, DISTRIBUTIVITY
and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-ADDER.

Subgoal *1/3.1
(IMPLIES
   (AND (CONSP Y)
        (NOT (CAR Y))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X)
        (NOT (CAR X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, N
and SERIAL-ADDER, the :executable-counterparts of FULL-ADDER and MV-
NTH, primitive type reasoning, the :rewrite rules CAR-CONS, CDR-CONS,
COMMUTATIVITY-OF-+, DISTRIBUTIVITY and UNICITY-OF-0 and the :type-
prescription rules N and SERIAL-ADDER.

Subgoal *1/2
(IMPLIES
     (AND (NOT (ENDP Y))
          (CAR Y)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X))
                    (N (CDR Y))
                    (IF (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))
                        1 0))))
     (EQUAL (N (SERIAL-ADDER X Y C))
            (+ (N X) (N Y) (IF C 1 0)))).

This simplifies, using the :definitions FULL-ADDER, MAJ, MV-NTH, N,
SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts of BINARY-
+, CAR, CONSP, EQ, IF, XOR and ZP, primitive type reasoning and the
:rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+, to the following nine conjectures.

Subgoal *1/2.9
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          C)
     (EQUAL (N (CONS T
                     (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
            (+ 1 1 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

Subgoal *1/2.9'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          C)
     (EQUAL (+ 1
               (* 2
                  (N (SERIAL-ADDER (CDR X)
                                   (CDR Y)
                                   (CAR Y)))))
            (+ 3 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, SYNTAXP and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning and
the :rewrite rules CDR-CONS, DISTRIBUTIVITY and FOLD-CONSTS-IN-+.

Subgoal *1/2.8
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          (CAR X)
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X))
          C)
     (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 1 1 (* 2 (N (CDR Y))) 0))).

But simplification reduces this to T, using trivial observations.

Subgoal *1/2.7
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL
                   (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
          (+ 1 0 (* 2 (N (CDR Y)))
             1 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/2.7'
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (CONSP X)
        (NOT C))
   (EQUAL (N (CONS NIL
                   (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
          (+ 1
             (FIX (+ (* 2 (N (CDR Y)))
                     1 (* 2 (N (CDR X)))))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, MV-NTH, N, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+, DISTRIBUTIVITY and FOLD-CONSTS-IN-+ and the :type-prescription
rules N and SERIAL-ADDER.

Subgoal *1/2.6
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 1 0 (* 2 (N (CDR Y))) 0))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/2.6'
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (CAR X)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 1))
        (NOT (CONSP X))
        (NOT C))
   (EQUAL (N (CONS T (SERIAL-ADDER NIL (CDR Y) NIL)))
          (+ 1 (FIX (+ (* 2 (N (CDR Y))) 0))))).

But we reduce the conjecture to T, by case analysis.

Subgoal *1/2.5
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (NOT (CAR X))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (CONSP X))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ 1 (* 2 (N (CDR Y)))
             (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, N, SERIAL-ADDER and XOR, the :executable-counterparts of
CONS, MV-NTH and XOR, primitive type reasoning, the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DISTRIBUTIVITY and UNICITY-
OF-0 and the :type-prescription rules N and SERIAL-ADDER.

Subgoal *1/2.4
(IMPLIES
   (AND (CONSP Y)
        (CAR Y)
        (NOT (CAR X))
        (NOT C)
        (EQUAL (N (SERIAL-ADDER (CDR X)
                                (CDR Y)
                                (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) NIL))))
               (+ (N (CDR X)) (N (CDR Y)) 0))
        (NOT (CONSP X)))
   (EQUAL (N (SERIAL-ADDER X Y NIL))
          (+ 1 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, N, SERIAL-
ADDER and XOR, the :executable-counterparts of CONS, EQUAL, FIX, MV-
NTH and XOR, primitive type reasoning, the :rewrite rules CAR-CONS,
CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-CAR, DEFAULT-CDR, LEFT-CANCELLATION-
FOR-*, LEFT-CANCELLATION-FOR-+ and UNICITY-OF-0 and the :type-prescription
rules N and SERIAL-ADDER, to

Subgoal *1/2.4'
(IMPLIES (AND (CONSP Y)
              (CAR Y)
              (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                     (+ (N (CDR X)) (N (CDR Y))))
              (NOT (CONSP X)))
         (EQUAL (N (SERIAL-ADDER NIL (CDR Y) NIL))
                (N (CDR Y)))).

But simplification reduces this to T, using the :definition FIX, the
:executable-counterpart of N, the :rewrite rules DEFAULT-CDR and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/2.3
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (NOT (CONSP X)))
     (EQUAL (N (CONS NIL (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y))) 0))).

This simplifies, using the :definitions FIX and N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and UNICITY-OF-0 and the :type-prescription rules N and SERIAL-
ADDER, to

Subgoal *1/2.3'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (NOT (CONSP X)))
     (EQUAL (* 2 (N (SERIAL-ADDER NIL (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FIX, FULL-
ADDER, MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, N, XOR and ZP, primitive type reasoning, the :rewrite
rules CDR-CONS, DEFAULT-CAR, DEFAULT-CDR, DISTRIBUTIVITY and UNICITY-
OF-0 and the :type-prescription rule N.

Subgoal *1/2.2
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          (CAR X))
     (EQUAL (N (CONS T
                     (SERIAL-ADDER (CDR X) (CDR Y) (CAR Y))))
            (+ 2 (* 2 (N (CDR Y)))
               1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N and SYNTAXP, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, COMMUTATIVITY-
OF-+ and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-ADDER,
to

Subgoal *1/2.2'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          (CAR X))
     (EQUAL (+ 1
               (* 2
                  (N (SERIAL-ADDER (CDR X)
                                   (CDR Y)
                                   (CAR Y)))))
            (+ 3 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, SYNTAXP and XOR, the :executable-counterparts of BINARY-
*, BINARY-+, CAR, CONSP, EQ, IF and ZP, primitive type reasoning and
the :rewrite rules CDR-CONS, DISTRIBUTIVITY and FOLD-CONSTS-IN-+.

Subgoal *1/2.1
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ (N (CDR X)) (N (CDR Y)) 1))
          (CONSP X)
          (NOT (CAR X)))
     (EQUAL (N (CONS NIL (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR Y)))
               (* 2 (N (CDR X)))))).

This simplifies, using the :definition N, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+ and COMMUTATIVITY-
OF-+ and the :type-prescription rule SERIAL-ADDER, to

Subgoal *1/2.1'
(IMPLIES
     (AND (CONSP Y)
          (CAR Y)
          C
          (EQUAL (N (SERIAL-ADDER (CDR X)
                                  (CDR Y)
                                  (MV-NTH 1 (FULL-ADDER (CAR X) (CAR Y) C))))
                 (+ 1 (N (CDR X)) (N (CDR Y))))
          (CONSP X)
          (NOT (CAR X)))
     (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) (CDR Y) C)))
            (+ 2 (* 2 (N (CDR X)))
               (* 2 (N (CDR Y)))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH and XOR, the :executable-counterparts of BINARY-*, BINARY-
+, XOR and ZP, primitive type reasoning and the :rewrite rules CDR-
CONS and DISTRIBUTIVITY.

Subgoal *1/1
(IMPLIES (ENDP Y)
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) (IF C 1 0)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP Y))
         (EQUAL (N (SERIAL-ADDER X Y C))
                (+ (N X) (N Y) (IF C 1 0)))).

This simplifies, using the :definitions FIX, FULL-ADDER, MAJ, MV-NTH,
N, SERIAL-ADDER and XOR, the :executable-counterparts of BINARY-+,
CONS, EQUAL, N and ZP, primitive type reasoning and the :rewrite rules
CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, DEFAULT-CAR, DEFAULT-CDR and
UNICITY-OF-0, to the following five conjectures.

Subgoal *1/1.5
(IMPLIES (AND (NOT (CONSP Y)) (NOT (CONSP X)) C)
         (EQUAL (N (LIST C)) (+ 1 0))).

By the :executable-counterpart of BINARY-+ we reduce the conjecture
to

Subgoal *1/1.5'
(IMPLIES (AND (NOT (CONSP Y)) (NOT (CONSP X)) C)
         (EQUAL (N (LIST C)) 1)).

But simplification reduces this to T, using the :definition N, the
:executable-counterparts of BINARY-*, BINARY-+, EQUAL and N, primitive
type reasoning and the :rewrite rules CAR-CONS and CDR-CONS.

Subgoal *1/1.4
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) T)
                         (SERIAL-ADDER (CDR X) NIL C)))
                (+ 1 1 (* 2 (N (CDR X)))))).

This simplifies, using the :definitions N, SYNTAXP and XOR, the :executable-
counterparts of BINARY-+, CAR, CONSP, EQ and IF, primitive type reasoning,
the :rewrite rules CAR-CONS, CDR-CONS and FOLD-CONSTS-IN-+ and the
:type-prescription rule SERIAL-ADDER, to

Subgoal *1/1.4'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (CAR X))
         (EQUAL (* 2 (N (SERIAL-ADDER (CDR X) NIL C)))
                (+ 2 (* 2 (N (CDR X)))))).

The destructor terms (CAR X) and (CDR X) can be eliminated by using
CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing (CAR X) to
X1 and (CDR X) to X2.  This produces the following goal.

Subgoal *1/1.4''
(IMPLIES (AND (CONSP (CONS X1 X2))
              (NOT (CONSP Y))
              C X1)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

This simplifies, using primitive type reasoning, to

Subgoal *1/1.4'''
(IMPLIES (AND (NOT (CONSP Y)) C X1)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

This simplifies, using trivial observations, to

Subgoal *1/1.4'4'
(IMPLIES (AND (NOT (CONSP Y)) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

We suspect that the term (NOT (CONSP Y)) is irrelevant to the truth
of this conjecture and throw it out.  We will thus try to prove

Subgoal *1/1.4'5'
(IMPLIES C
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

Name the formula above *1.1.

Subgoal *1/1.3
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 0 1 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/1.3'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (CAR X))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (FIX (+ 1 (* 2 (N (CDR X))))))).

But simplification reduces this to T, using the :definitions FIX, N
and XOR, primitive type reasoning, the :rewrite rules CAR-CONS, CDR-
CONS and SERIAL-ADDER-SPECIAL-CASE and the :type-prescription rules
N and SERIAL-ADDER.

Subgoal *1/1.2
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              C (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) T)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 1 (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definition N, the
:executable-counterpart of XOR, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS and SERIAL-ADDER-SPECIAL-CASE and the :type-
prescription rule SERIAL-ADDER.

Subgoal *1/1.1
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (+ 0 (* 2 (N (CDR X)))))).

By the simple :rewrite rule UNICITY-OF-0 we reduce the conjecture to

Subgoal *1/1.1'
(IMPLIES (AND (NOT (CONSP Y))
              (CONSP X)
              (NOT C)
              (NOT (CAR X)))
         (EQUAL (N (CONS (XOR (CAR X) NIL)
                         (SERIAL-ADDER (CDR X) NIL NIL)))
                (FIX (* 2 (N (CDR X)))))).

But simplification reduces this to T, using the :definitions FIX and
N, the :executable-counterpart of XOR, primitive type reasoning, the
:rewrite rules CAR-CONS, CDR-CONS and SERIAL-ADDER-SPECIAL-CASE and
the :type-prescription rules N and SERIAL-ADDER.

So we now return to *1.1, which is

(IMPLIES C
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

Perhaps we can prove *1.1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (N X2).  If we let
 (:P C X2) denote *1.1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X2))
                   (NOT (CAR X2))
                   (:P C (CDR X2)))
              (:P C X2))
     (IMPLIES (AND (NOT (ENDP X2))
                   (CAR X2)
                   (:P C (CDR X2)))
              (:P C X2))
     (IMPLIES (ENDP X2) (:P C X2))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT X2) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  When applied to the goal at hand the above induction
scheme produces the following three nontautological subgoals.

Subgoal *1.1/3
(IMPLIES (AND (NOT (ENDP X2))
              (NOT (CAR X2))
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/3'
(IMPLIES (AND (CONSP X2)
              (NOT (CAR X2))
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, N, SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, CAR, CDR, CONS, CONSP, EQ, IF, MV-NTH and XOR, primitive
type reasoning, the :rewrite rules CAR-CONS, CDR-CONS, DISTRIBUTIVITY,
FOLD-CONSTS-IN-* and SERIAL-ADDER-SPECIAL-CASE and the :type-prescription
rule SERIAL-ADDER.

Subgoal *1.1/2
(IMPLIES (AND (NOT (ENDP X2))
              (CAR X2)
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/2'
(IMPLIES (AND (CONSP X2)
              (CAR X2)
              (EQUAL (* 2 (N (SERIAL-ADDER (CDR X2) NIL C)))
                     (+ 2 (* 2 (N (CDR X2)))))
              C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

But simplification reduces this to T, using the :definitions FULL-ADDER,
MAJ, MV-NTH, N, SERIAL-ADDER, SYNTAXP and XOR, the :executable-counterparts
of BINARY-*, BINARY-+, CAR, CDR, CONSP, EQ, IF and ZP, primitive type
reasoning, the :rewrite rules CAR-CONS, CDR-CONS, DISTRIBUTIVITY, FOLD-
CONSTS-IN-* and FOLD-CONSTS-IN-+ and the :type-prescription rule SERIAL-
ADDER.

Subgoal *1.1/1
(IMPLIES (AND (ENDP X2) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1.1/1'
(IMPLIES (AND (NOT (CONSP X2)) C)
         (EQUAL (* 2 (N (SERIAL-ADDER X2 NIL C)))
                (+ 2 (* 2 (N X2))))).

But simplification reduces this to T, using the :definitions N and
SERIAL-ADDER, the :executable-counterparts of BINARY-*, BINARY-+, CONSP,
EQUAL and N, primitive type reasoning and the :rewrite rules CAR-CONS
and CDR-CONS.

That completes the proofs of *1.1 and *1.

Q.E.D.

Summary
Form:  ( DEFTHM SERIAL-ADDER-CORRECT ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION FIX)
        (:DEFINITION FULL-ADDER)
        (:DEFINITION MAJ)
        (:DEFINITION MV-NTH)
        (:DEFINITION N)
        (:DEFINITION NOT)
        (:DEFINITION SERIAL-ADDER)
        (:DEFINITION SYNTAXP)
        (:DEFINITION XOR)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART BINARY-*)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART FIX)
        (:EXECUTABLE-COUNTERPART FULL-ADDER)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART MV-NTH)
        (:EXECUTABLE-COUNTERPART N)
        (:EXECUTABLE-COUNTERPART XOR)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE DEFAULT-CAR)
        (:REWRITE DEFAULT-CDR)
        (:REWRITE DISTRIBUTIVITY)
        (:REWRITE FOLD-CONSTS-IN-*)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE LEFT-CANCELLATION-FOR-*)
        (:REWRITE LEFT-CANCELLATION-FOR-+)
        (:REWRITE SERIAL-ADDER-SPECIAL-CASE)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION N)
        (:TYPE-PRESCRIPTION SERIAL-ADDER))
Warnings:  Subsume
Time:  2.22 seconds (prove: 1.81, print: 0.39, other: 0.02)
 SERIAL-ADDER-CORRECT
ACL2 !>


[top] [prev] [next]

ACL2 !>(defun multiplier (x y p)
         (if (endp x)
             p
             (multiplier (cdr x)
		         (cons nil y)
                         (if (car x)
                             (serial-adder y p nil)
                             p))))

Here is a shift-and-add multiplier. Note that it uses our serial adder. Note also that bit vectors y and p, which are repeatedly added, are not the same length.


[top] [prev] [next]

ACL2 !>(defun multiplier (x y p)
         (if (endp x)
             p
             (multiplier (cdr x)
		         (cons nil y)
                         (if (car x)
                             (serial-adder y p nil)
                             p))))

The admission of MULTIPLIER is trivial, using the relation E0-ORD-<
(which is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  We observe that the type of MULTIPLIER
is described by the theorem 
(OR (AND (CONSP (MULTIPLIER X Y P))
         (TRUE-LISTP (MULTIPLIER X Y P)))
    (EQUAL (MULTIPLIER X Y P) P)).
We used the :type-prescription rule SERIAL-ADDER.

Summary
Form:  ( DEFUN MULTIPLIER ...)
Rules: ((:TYPE-PRESCRIPTION SERIAL-ADDER))
Warnings:  None
Time:  0.02 seconds (prove: 0.00, print: 0.01, other: 0.01)
 MULTIPLIER
ACL2 !>


[top] [prev] [next]

ACL2 !>(n '(nil nil nil t nil t t t t t))

We'll use the multiplier to square this vector. But first we'll determine the numeric value of the vector.


[top] [prev] [next]

ACL2 !>(n '(nil nil nil t nil t t t t t))
1000
ACL2 !>


[top] [prev] [next]

ACL2 !>(n '(nil nil nil t nil t t t t t))
1000
ACL2 !>(n (multiplier '(nil nil nil t nil t t t t t) 
                      '(nil nil nil t nil t t t t t)
                      nil))


[top] [prev] [next]

ACL2 !>(n '(nil nil nil t nil t t t t t))
1000
ACL2 !>(n (multiplier '(nil nil nil t nil t t t t t) 
                      '(nil nil nil t nil t t t t t)
                      nil))
1000000
ACL2 !>

Sure enough, 1000 x 1000 is 1000000.


[top] [prev] [next]

ACL2 !>(defthm multiplier-correct
         (equal (n (multiplier x y p))
                (+ (* (n x) (n y)) (n p))))

This is the correctness statement for the multiplier.


[top] [prev] [next]

ACL2 !>(defthm multiplier-correct
         (equal (n (multiplier x y p))
                (+ (* (n x) (n y)) (n p))))

This simplifies, using the :rewrite rule COMMUTATIVITY-OF-+, to

Goal'
(EQUAL (N (MULTIPLIER X Y P))
       (+ (N P) (* (N X) (N Y)))).

Name the formula above *1.

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

We will induct according to a scheme suggested by (N X), but modified
to accommodate (MULTIPLIER X Y P).  If we let  (:P P X Y) denote *1
above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X))
                   (NOT (CAR X))
                   (:P (IF (CAR X) (SERIAL-ADDER Y P NIL) P)
                       (CDR X)
                       (CONS NIL Y)))
              (:P P X Y))
     (IMPLIES (AND (NOT (ENDP X))
                   (CAR X)
                   (:P (IF (CAR X) (SERIAL-ADDER Y P NIL) P)
                       (CDR X)
                       (CONS NIL Y)))
              (:P P X Y))
     (IMPLIES (ENDP X) (:P P X Y))).
This induction is justified by the same argument used to admit N, namely,
the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  Note, however, that the unmeasured variables Y and
P are being instantiated.  When applied to the goal at hand the above
induction scheme produces the following three nontautological subgoals.

Subgoal *1/3
(IMPLIES (AND (NOT (ENDP X))
              (NOT (CAR X))
              (EQUAL (N (MULTIPLIER (CDR X)
                                    (CONS NIL Y)
                                    (IF (CAR X) (SERIAL-ADDER Y P NIL) P)))
                     (+ (N (IF (CAR X) (SERIAL-ADDER Y P NIL) P))
                        (* (N (CDR X)) (N (CONS NIL Y))))))
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/3'
(IMPLIES (AND (CONSP X)
              (NOT (CAR X))
              (EQUAL (N (MULTIPLIER (CDR X)
                                    (CONS NIL Y)
                                    (IF (CAR X) (SERIAL-ADDER Y P NIL) P)))
                     (+ (N (IF (CAR X) (SERIAL-ADDER Y P NIL) P))
                        (* (N (CDR X)) (N (CONS NIL Y))))))
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

But simplification reduces this to T, using the :definitions MULTIPLIER
and N, primitive type reasoning and the :rewrite rules CAR-CONS, CDR-
CONS, COMMUTATIVITY-2-OF-* and COMMUTATIVITY-OF-*.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (CAR X)
              (EQUAL (N (MULTIPLIER (CDR X)
                                    (CONS NIL Y)
                                    (IF (CAR X) (SERIAL-ADDER Y P NIL) P)))
                     (+ (N (IF (CAR X) (SERIAL-ADDER Y P NIL) P))
                        (* (N (CDR X)) (N (CONS NIL Y))))))
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (CAR X)
              (EQUAL (N (MULTIPLIER (CDR X)
                                    (CONS NIL Y)
                                    (IF (CAR X) (SERIAL-ADDER Y P NIL) P)))
                     (+ (N (IF (CAR X) (SERIAL-ADDER Y P NIL) P))
                        (* (N (CDR X)) (N (CONS NIL Y))))))
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

But simplification reduces this to T, using the :definitions FIX, MULTIPLIER
and N, primitive type reasoning, the :rewrite rules ASSOCIATIVITY-OF-
+, CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-*, COMMUTATIVITY-OF-*, COMMUTATIVITY\
-OF-+, DISTRIBUTIVITY, SERIAL-ADDER-CORRECT, UNICITY-OF-0 and UNICITY-
OF-1 and the :type-prescription rule N.

Subgoal *1/1
(IMPLIES (ENDP X)
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (EQUAL (N (MULTIPLIER X Y P))
                (+ (N P) (* (N X) (N Y))))).

But simplification reduces this to T, using the :definitions FIX, MULTIPLIER
and N, primitive type reasoning, the :rewrite rules COMMUTATIVITY-OF-
+, TIMES-ZERO and UNICITY-OF-0 and the :type-prescription rule N.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM MULTIPLIER-CORRECT ...)
Rules: ((:DEFINITION ENDP)
        (:DEFINITION FIX)
        (:DEFINITION MULTIPLIER)
        (:DEFINITION N)
        (:DEFINITION NOT)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE ASSOCIATIVITY-OF-+)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-*)
        (:REWRITE COMMUTATIVITY-OF-*)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE DISTRIBUTIVITY)
        (:REWRITE SERIAL-ADDER-CORRECT)
        (:REWRITE TIMES-ZERO)
        (:REWRITE UNICITY-OF-0)
        (:REWRITE UNICITY-OF-1)
        (:TYPE-PRESCRIPTION N))
Warnings:  None
Time:  0.19 seconds (prove: 0.11, print: 0.06, other: 0.02)
 MULTIPLIER-CORRECT
ACL2 !>


[top] [prev] [next]

A Simple Netlist Description Language

Next we define a very simple occurrence-oriented netlist description language. A netlist is a list that assigns to ``wires'' the values of ``gate expressions'' which take wires as inputs. The ``value'' of a netlist under some assignment of values to the input wires is computed by assigning the appropriate value to each wire in turn.

We have already defined recursive functions for adding and multiplying bit vectors. The advantage of a netlist over such functional descriptions is that the netlist language allows the user to describe explicitly the structure of the circuit, control the fan out, etc.

The plan is as follows.

We define adder-net to generate a netlist for an n-bit ripple carry adder.
We show the netlist generated for a 3-big adder.
We define the semantics of a netlist, i.e., how to compute the value of the output wires in terms of the values of the input wires.
We prove that the netlist generated by adder-net is arithmetically correct, i.e., it adds. The proof exploits the fact that serial-adder adds: we just prove that adder-net ``does the same thing'' as serial-adder.


[top] [prev] [next]

ACL2 !>(defun adder-net (a b c i)
        (cond
         ((endp a)
          `((,i ,c *)))
         (t `((,i (xor ,(car b) ,c))
              (,(+ i 1) (xor ,(car a) ,i) *)
              (,(+ i 2) (maj ,(car a) ,(car b) ,c))
              ,@(adder-net (cdr a)
                           (cdr b)
                           (+ i 2)
                           (+ i 3))))))

The function definition above is pretty inscrutible unless you know about Lisp's ``backquote'' notation. Just accept the function and then we'll show an example of it and explain, soon.


[top] [prev] [next]

ACL2 !>(defun adder-net (a b c i)
        (cond
         ((endp a)
          `((,i ,c *)))
         (t `((,i (xor ,(car b) ,c))
              (,(+ i 1) (xor ,(car a) ,i) *)
              (,(+ i 2) (maj ,(car a) ,(car b) ,c))
              ,@(adder-net (cdr a)
                           (cdr b)
                           (+ i 2)
                           (+ i 3))))))

The admission of ADDER-NET is trivial, using the relation E0-ORD-<
(which is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT A).  We observe that the type of ADDER-
NET is described by the theorem (CONSP (ADDER-NET A B C I)).  We used
primitive type reasoning.

Summary
Form:  ( DEFUN ADDER-NET ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.00, other: 0.01)
 ADDER-NET
ACL2 !>


[top] [prev] [next]

ACL2 !>(adder-net '(a0 a1 a2) '(b0 b1 b2) 'c 0)

The call above generates an adder for two 3-bit vectors. The input wires are named a0, ..., a2 and b0, ..., b2. The input carry wire is named c. Internal wires will be numbered, starting from 0.


[top] [prev] [next]

ACL2 !>(adder-net '(a0 a1 a2) '(b0 b1 b2) 'c 0)
((0 (XOR B0 C))
 (1 (XOR A0 0) *)
 (2 (MAJ A0 B0 C))
 (3 (XOR B1 2))
 (4 (XOR A1 3) *)
 (5 (MAJ A1 B1 2))
 (6 (XOR B2 5))
 (7 (XOR A2 6) *)
 (8 (MAJ A2 B2 5))
 (9 8 *))
ACL2 !>

You can see a netlist above. It means ``wire 0 gets the exclusive-or of wires b0 and c, wire 1 gets the exclusive-or of a0 and wire 0, etc.'' Any wire marked with a * is understood as an output wire.

The function adder-net generated this netlist. Adder-net is supposed to generate ripple-carry adders for vectors of arbitrary width. You might want to go back to the definition of adder-net to see how it is done. Basically, at each step in its recursion, it generates the three wires necessary to compute the next output bit and the carry out, marking the appropriate output wire with a *. It adds those wires to the result of computing a netlist for the rest of the input wires, passing the recursive call the number of wire holding the output carry of the current bit (to be the input carry) and the number of the next ``available'' wire. Lisp's backquote notation lets us define this symbol-manipulation process succinctly. Our job is to prove that adder-net generates correct adders.


[top] [prev] [next]

ACL2 !>(defun net-val (netlist alist)
        (cond
         ((endp netlist) nil)
         (t (let* ((wire-name (car (car netlist)))
                   (gate-expr (cadr (car netlist)))
                   (output-flag (caddr (car netlist)))
                   (val (evaluate-gate gate-expr alist))
                   (ans (net-val (cdr netlist)
                                 (bind wire-name val alist))))
              (cond
               ((eq output-flag '*)
                (cons val ans))
               (t ans))))))

To prove adder-net correct, we have to define the semantics of netlists. This function determines the value of a netlist under an assignment of values to the input wires.


[top] [prev] [next]

ACL2 !>(defun net-val (netlist alist)
        (cond
         ((endp netlist) nil)
         (t (let* ((wire-name (car (car netlist)))
                   (gate-expr (cadr (car netlist)))
                   (output-flag (caddr (car netlist)))
                   (val (evaluate-gate gate-expr alist))
                   (ans (net-val (cdr netlist)
                                 (bind wire-name val alist))))
              (cond
               ((eq output-flag '*)
                (cons val ans))
               (t ans))))))

The admission of NET-VAL is trivial, using the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT NETLIST).  We observe that the type of
NET-VAL is described by the theorem (TRUE-LISTP (NET-VAL NETLIST ALIST)).
We used primitive type reasoning.

Summary
Form:  ( DEFUN NET-VAL ...)
Rules: ((:FAKE-RUNE-FOR-TYPE-SET NIL))
Warnings:  None
Time:  0.03 seconds (prove: 0.00, print: 0.00, other: 0.03)
 NET-VAL
ACL2 !>


[top] [prev] [next]

ACL2 !>(net-val '((0 (xor a1 b1))
                  (1 (xor c 0) *))
                '((a1 . t) (b1 . nil) (c . nil)))

What will this netlist return if a1 is t, b1 is nil, and c is nil?


[top] [prev] [next]

ACL2 !>(net-val '((0 (xor a1 b1))
                  (1 (xor c 0) *))
                '((a1 . t) (b1 . nil) (c . nil)))
(T)
ACL2 !>

A list containing T. I.e., one output, which is the exclusive-or of the three inputs. Did you get it right?


[top] [prev] [next]

ACL2 !>(defthm true-listp-adder-net
         (true-listp (adder-net a b c i)))

This is a simple lemma about the adder-net that we need to prove the next theorem.


[top] [prev] [next]

ACL2 !>(defthm true-listp-adder-net
         (true-listp (adder-net a b c i)))

Name the formula above *1.

Perhaps we can prove *1 by induction.  One induction scheme is suggested
by this conjecture.  

We will induct according to a scheme suggested by (ADDER-NET A B C I).
If we let  (:P A B C I) denote *1 above then the induction scheme we'll
use is
(AND (IMPLIES (AND (NOT (ENDP A))
                   (:P (CDR A) (CDR B) (+ I 2) (+ I 3)))
              (:P A B C I))
     (IMPLIES (ENDP A) (:P A B C I))).
This induction is justified by the same argument used to admit ADDER-
NET, namely, the measure (ACL2-COUNT A) is decreasing according to
the relation E0-ORD-< (which is known to be well-founded on the domain
recognized by E0-ORDINALP).  Note, however, that the unmeasured variables
B, C and I are being instantiated.  When applied to the goal at hand
the above induction scheme produces the following two nontautological
subgoals.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP A))
              (TRUE-LISTP (ADDER-NET (CDR A)
                                     (CDR B)
                                     (+ I 2)
                                     (+ I 3))))
         (TRUE-LISTP (ADDER-NET A B C I))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP A)
              (TRUE-LISTP (ADDER-NET (CDR A)
                                     (CDR B)
                                     (+ I 2)
                                     (+ I 3))))
         (TRUE-LISTP (ADDER-NET A B C I))).

But simplification reduces this to T, using the :definition ADDER-NET,
primitive type reasoning, the :rewrite rules APPEND-RIGHT-ID and COMMUTATIVITY\
-OF-+ and the :type-prescription rule ADDER-NET.

Subgoal *1/1
(IMPLIES (ENDP A)
         (TRUE-LISTP (ADDER-NET A B C I))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP A))
         (TRUE-LISTP (ADDER-NET A B C I))).

But simplification reduces this to T, using the :definition ADDER-NET
and primitive type reasoning.

That completes the proof of *1.

Q.E.D.

The storage of TRUE-LISTP-ADDER-NET depends upon the :type-prescription
rule TRUE-LISTP.

Summary
Form:  ( DEFTHM TRUE-LISTP-ADDER-NET ...)
Rules: ((:DEFINITION ADDER-NET)
        (:DEFINITION ENDP)
        (:DEFINITION NOT)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE APPEND-RIGHT-ID)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:TYPE-PRESCRIPTION ADDER-NET)
        (:TYPE-PRESCRIPTION TRUE-LISTP))
Warnings:  None
Time:  0.04 seconds (prove: 0.01, print: 0.01, other: 0.02)
 TRUE-LISTP-ADDER-NET
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm adder-net-is-serial-adder
         (implies (and (symbol-listp a)
                       (symbol-listp b)
                       (equal (len a) (len b))
                       (integerp i)
                       (or (symbolp c)
                           (and (integerp c)
                                (< c i))))
                  (equal (net-val (adder-net a b c i) alist)
                         (serial-adder (lookup-all a alist)
                                       (lookup-all b alist)
                                       (lookup c alist))))
  :hints (("Goal" :induct (net-val-hint a b c i alist)
                  :in-theory (disable xor maj))))

We wish to prove that adder-net adds, in the arithmetic sense. We'll prove that theorem in a moment. The conjecture above is a stepping-stone in that proof.

We have already proved that serial-adder adds in the arithmetic sense. So it should suffice to prove that adder-net ``does the same thing'' as serial-adder. That is what the conjecture above says. Note that even though our ultimate goal is about arithmetic addition the lemma above is not about arithmetic. It is about bit vector manipulation.

There are two :hints above. The first tells the theorem prover what induction argument to use -- it cannot figure out an appropriate one on its own and fails if we don't help it. The second tells it not to expand the definitions of xor or maj: what they do is unimportant because both adder-net and serial-adder use them in unison in this example. The proof is uneventful.


[top] [prev] [next]

ACL2 !>(defthm adder-net-is-serial-adder
         (implies (and (symbol-listp a)
                       (symbol-listp b)
                       (equal (len a) (len b))
                       (integerp i)
                       (or (symbolp c)
                           (and (integerp c)
                                (< c i))))
                  (equal (net-val (adder-net a b c i) alist)
                         (serial-adder (lookup-all a alist)
                                       (lookup-all b alist)
                                       (lookup c alist))))
  :hints (("Goal" :induct (net-val-hint a b c i alist)
                  :in-theory (disable xor maj))))

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

Name the formula above *1.

We have been told to use induction.  One induction scheme is suggested
by the induction hint.  

We will induct according to a scheme suggested by 
(NET-VAL-HINT A B C I ALIST).  If we let  (:P A ALIST B C I) denote
*1 above then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP A))
                   (:P (CDR A)
                       (LIST* (CONS (+ 2 I)
                                    (MAJ (LOOKUP (CAR A) ALIST)
                                         (LOOKUP (CAR B) ALIST)
                                         (LOOKUP C ALIST)))
                              (CONS (+ 1 I)
                                    (XOR (LOOKUP (CAR A) ALIST)
                                         (XOR (LOOKUP (CAR B) ALIST)
                                              (LOOKUP C ALIST))))
                              (CONS I
                                    (XOR (LOOKUP (CAR B) ALIST)
                                         (LOOKUP C ALIST)))
                              ALIST)
                       (CDR B)
                       (+ I 2)
                       (+ I 3)))
              (:P A ALIST B C I))
     (IMPLIES (ENDP A) (:P A ALIST B C I))).
This induction is justified by the same argument used to admit NET-
VAL-HINT, namely, the measure (ACL2-COUNT A) is decreasing according
to the relation E0-ORD-< (which is known to be well-founded on the
domain recognized by E0-ORDINALP).  Note, however, that the unmeasured
variables B, C, I and ALIST are being instantiated.  When applied to
the goal at hand the above induction scheme produces the following
two nontautological subgoals.

Subgoal *1/2
(IMPLIES
 (AND
  (NOT (ENDP A))
  (IMPLIES
   (AND (SYMBOL-LISTP (CDR A))
        (SYMBOL-LISTP (CDR B))
        (EQUAL (LEN (CDR A)) (LEN (CDR B)))
        (INTEGERP (+ I 3))
        (OR (SYMBOLP (+ I 2))
            (AND (INTEGERP (+ I 2))
                 (< (+ I 2) (+ I 3)))))
   (EQUAL
      (NET-VAL (ADDER-NET (CDR A)
                          (CDR B)
                          (+ I 2)
                          (+ I 3))
               (LIST* (CONS (+ 2 I)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      (CONS (+ 1 I)
                            (XOR (LOOKUP (CAR A) ALIST)
                                 (XOR (LOOKUP (CAR B) ALIST)
                                      (LOOKUP C ALIST))))
                      (CONS I
                            (XOR (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      ALIST))
      (SERIAL-ADDER (LOOKUP-ALL (CDR A)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP-ALL (CDR B)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP (+ I 2)
                            (LIST* (CONS (+ 2 I)
                                         (MAJ (LOOKUP (CAR A) ALIST)
                                              (LOOKUP (CAR B) ALIST)
                                              (LOOKUP C ALIST)))
                                   (CONS (+ 1 I)
                                         (XOR (LOOKUP (CAR A) ALIST)
                                              (XOR (LOOKUP (CAR B) ALIST)
                                                   (LOOKUP C ALIST))))
                                   (CONS I
                                         (XOR (LOOKUP (CAR B) ALIST)
                                              (LOOKUP C ALIST)))
                                   ALIST))))))
 (IMPLIES (AND (SYMBOL-LISTP A)
               (SYMBOL-LISTP B)
               (EQUAL (LEN A) (LEN B))
               (INTEGERP I)
               (OR (SYMBOLP C)
                   (AND (INTEGERP C) (< C I))))
          (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
                 (SERIAL-ADDER (LOOKUP-ALL A ALIST)
                               (LOOKUP-ALL B ALIST)
                               (LOOKUP C ALIST))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES
 (AND
  (CONSP A)
  (OR
   (NOT (AND (SYMBOL-LISTP (CDR A))
             (SYMBOL-LISTP (CDR B))
             (EQUAL (LEN (CDR A)) (LEN (CDR B)))
             (INTEGERP (+ I 3))
             (OR (SYMBOLP (+ I 2))
                 (AND (INTEGERP (+ I 2))
                      (< (+ I 2) (+ I 3))))))
   (EQUAL
      (NET-VAL (ADDER-NET (CDR A)
                          (CDR B)
                          (+ I 2)
                          (+ I 3))
               (LIST* (CONS (+ 2 I)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      (CONS (+ 1 I)
                            (XOR (LOOKUP (CAR A) ALIST)
                                 (XOR (LOOKUP (CAR B) ALIST)
                                      (LOOKUP C ALIST))))
                      (CONS I
                            (XOR (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      ALIST))
      (SERIAL-ADDER (LOOKUP-ALL (CDR A)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP-ALL (CDR B)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP (+ I 2)
                            (LIST* (CONS (+ 2 I)
                                         (MAJ (LOOKUP (CAR A) ALIST)
                                              (LOOKUP (CAR B) ALIST)
                                              (LOOKUP C ALIST)))
                                   (CONS (+ 1 I)
                                         (XOR (LOOKUP (CAR A) ALIST)
                                              (XOR (LOOKUP (CAR B) ALIST)
                                                   (LOOKUP C ALIST))))
                                   (CONS I
                                         (XOR (LOOKUP (CAR B) ALIST)
                                              (LOOKUP C ALIST)))
                                   ALIST)))))
  (SYMBOL-LISTP A)
  (SYMBOL-LISTP B)
  (EQUAL (LEN A) (LEN B))
  (INTEGERP I)
  (OR (SYMBOLP C)
      (AND (INTEGERP C) (< C I))))
 (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
        (SERIAL-ADDER (LOOKUP-ALL A ALIST)
                      (LOOKUP-ALL B ALIST)
                      (LOOKUP C ALIST)))).

This simplifies, using the :definitions FIX, FULL-ADDER, LEN, LOOKUP,
LOOKUP-ALL, MV-NTH, SERIAL-ADDER and SYMBOL-LISTP, the :executable-
counterparts of BINARY-+, CAR, CDR, CONSP, LEN, SYMBOL-LISTP and ZP,
primitive type reasoning, the :forward-chaining rule SYMBOL-LISTP-FORWARD-
TO-TRUE-LISTP, the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+ and LEFT-CANCELLATION-FOR-+ and the :type-prescription rules LEN,
LOOKUP-ALL and SYMBOL-LISTP, to the following four conjectures.

Subgoal *1/2.4
(IMPLIES
 (AND
  (CONSP A)
  (EQUAL
      (NET-VAL (ADDER-NET (CDR A)
                          (CDR B)
                          (+ 2 I)
                          (+ 3 I))
               (LIST* (CONS (+ 2 I)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      (CONS (+ 1 I)
                            (XOR (LOOKUP (CAR A) ALIST)
                                 (XOR (LOOKUP (CAR B) ALIST)
                                      (LOOKUP C ALIST))))
                      (CONS I
                            (XOR (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      ALIST))
      (SERIAL-ADDER (LOOKUP-ALL (CDR A)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP-ALL (CDR B)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (MAJ (LOOKUP (CAR A) ALIST)
                         (LOOKUP (CAR B) ALIST)
                         (LOOKUP C ALIST))))
  (SYMBOLP (CAR A))
  (SYMBOL-LISTP (CDR A))
  (CONSP B)
  (SYMBOLP (CAR B))
  (SYMBOL-LISTP (CDR B))
  (EQUAL (LEN (CDR A)) (LEN (CDR B)))
  (INTEGERP I)
  (SYMBOLP C))
 (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
        (CONS (XOR (LOOKUP (CAR A) ALIST)
                   (XOR (LOOKUP (CAR B) ALIST)
                        (LOOKUP C ALIST)))
              (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                            (LOOKUP-ALL (CDR B) ALIST)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))))).

But simplification reduces this to T, using the :definitions ADDER-
NET, BIND, EVALUATE-GATE, LOOKUP and NET-VAL, the :executable-counterparts
of CAR and EQUAL, primitive type reasoning, the :rewrite rules APPEND-
RIGHT-ID, CAR-CONS, CDR-CONS, COMMUTATIVITY-OF-+, INPUT-LOOKUP-ALL-
NOT-CHANGED and TRUE-LISTP-ADDER-NET and the :type-prescription rule
SYMBOL-LISTP.

Subgoal *1/2.3
(IMPLIES
 (AND
  (CONSP A)
  (EQUAL
      (NET-VAL (ADDER-NET (CDR A)
                          (CDR B)
                          (+ 2 I)
                          (+ 3 I))
               (LIST* (CONS (+ 2 I)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      (CONS (+ 1 I)
                            (XOR (LOOKUP (CAR A) ALIST)
                                 (XOR (LOOKUP (CAR B) ALIST)
                                      (LOOKUP C ALIST))))
                      (CONS I
                            (XOR (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))
                      ALIST))
      (SERIAL-ADDER (LOOKUP-ALL (CDR A)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (LOOKUP-ALL (CDR B)
                                (LIST* (CONS (+ 2 I)
                                             (MAJ (LOOKUP (CAR A) ALIST)
                                                  (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       (CONS (+ 1 I)
                                             (XOR (LOOKUP (CAR A) ALIST)
                                                  (XOR (LOOKUP (CAR B) ALIST)
                                                       (LOOKUP C ALIST))))
                                       (CONS I
                                             (XOR (LOOKUP (CAR B) ALIST)
                                                  (LOOKUP C ALIST)))
                                       ALIST))
                    (MAJ (LOOKUP (CAR A) ALIST)
                         (LOOKUP (CAR B) ALIST)
                         (LOOKUP C ALIST))))
  (SYMBOLP (CAR A))
  (SYMBOL-LISTP (CDR A))
  (CONSP B)
  (SYMBOLP (CAR B))
  (SYMBOL-LISTP (CDR B))
  (EQUAL (LEN (CDR A)) (LEN (CDR B)))
  (INTEGERP I)
  (INTEGERP C)
  (< C I))
 (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
        (CONS (XOR (LOOKUP (CAR A) ALIST)
                   (XOR (LOOKUP (CAR B) ALIST)
                        (LOOKUP C ALIST)))
              (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                            (LOOKUP-ALL (CDR B) ALIST)
                            (MAJ (LOOKUP (CAR A) ALIST)
                                 (LOOKUP (CAR B) ALIST)
                                 (LOOKUP C ALIST)))))).

This simplifies, using the :definitions ADDER-NET, BIND, EVALUATE-GATE,
LOOKUP and NET-VAL, the :executable-counterparts of CAR and EQUAL,
primitive type reasoning, the :rewrite rules APPEND-RIGHT-ID, CAR-CONS,
CDR-CONS, COMMUTATIVITY-OF-+, CONS-EQUAL, INPUT-LOOKUP-ALL-NOT-CHANGED
and TRUE-LISTP-ADDER-NET and the :type-prescription rule SYMBOL-LISTP,
to the following two conjectures.

Subgoal *1/2.3.2
(IMPLIES (AND (CONSP A)
              (EQUAL (NET-VAL (ADDER-NET (CDR A)
                                         (CDR B)
                                         (+ 2 I)
                                         (+ 3 I))
                              (LIST* (CONS (+ 2 I)
                                           (MAJ (LOOKUP (CAR A) ALIST)
                                                (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST)))
                                     (CONS (+ 1 I)
                                           (XOR (LOOKUP (CAR A) ALIST)
                                                (XOR (LOOKUP (CAR B) ALIST)
                                                     (LOOKUP C ALIST))))
                                     (CONS I
                                           (XOR (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST)))
                                     ALIST))
                     (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                                   (LOOKUP-ALL (CDR B) ALIST)
                                   (MAJ (LOOKUP (CAR A) ALIST)
                                        (LOOKUP (CAR B) ALIST)
                                        (LOOKUP C ALIST))))
              (SYMBOLP (CAR A))
              (SYMBOL-LISTP (CDR A))
              (CONSP B)
              (SYMBOLP (CAR B))
              (SYMBOL-LISTP (CDR B))
              (EQUAL (LEN (CDR A)) (LEN (CDR B)))
              (INTEGERP I)
              (INTEGERP C)
              (< C I)
              (EQUAL C (+ 1 I)))
         (EQUAL (NET-VAL (ADDER-NET (CDR A)
                                    (CDR B)
                                    (+ 2 I)
                                    (+ 3 I))
                         (LIST* (CONS (+ 2 I)
                                      (MAJ (LOOKUP (CAR A) ALIST)
                                           (LOOKUP (CAR B) ALIST)
                                           (XOR (LOOKUP (CAR A) ALIST)
                                                (XOR (LOOKUP (CAR B) ALIST)
                                                     (LOOKUP C ALIST)))))
                                (CONS (+ 1 I)
                                      (XOR (LOOKUP (CAR A) ALIST)
                                           (XOR (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST))))
                                (CONS I
                                      (XOR (LOOKUP (CAR B) ALIST)
                                           (LOOKUP C ALIST)))
                                ALIST))
                (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                              (LOOKUP-ALL (CDR B) ALIST)
                              (MAJ (LOOKUP (CAR A) ALIST)
                                   (LOOKUP (CAR B) ALIST)
                                   (LOOKUP C ALIST))))).

But simplification reduces this to T, using linear arithmetic and primitive
type reasoning.

Subgoal *1/2.3.1
(IMPLIES (AND (CONSP A)
              (EQUAL (NET-VAL (ADDER-NET (CDR A)
                                         (CDR B)
                                         (+ 2 I)
                                         (+ 3 I))
                              (LIST* (CONS (+ 2 I)
                                           (MAJ (LOOKUP (CAR A) ALIST)
                                                (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST)))
                                     (CONS (+ 1 I)
                                           (XOR (LOOKUP (CAR A) ALIST)
                                                (XOR (LOOKUP (CAR B) ALIST)
                                                     (LOOKUP C ALIST))))
                                     (CONS I
                                           (XOR (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST)))
                                     ALIST))
                     (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                                   (LOOKUP-ALL (CDR B) ALIST)
                                   (MAJ (LOOKUP (CAR A) ALIST)
                                        (LOOKUP (CAR B) ALIST)
                                        (LOOKUP C ALIST))))
              (SYMBOLP (CAR A))
              (SYMBOL-LISTP (CDR A))
              (CONSP B)
              (SYMBOLP (CAR B))
              (SYMBOL-LISTP (CDR B))
              (EQUAL (LEN (CDR A)) (LEN (CDR B)))
              (INTEGERP I)
              (INTEGERP C)
              (< C I)
              (NOT (EQUAL C (+ 1 I)))
              (EQUAL C I))
         (EQUAL (NET-VAL (ADDER-NET (CDR A)
                                    (CDR B)
                                    (+ 2 I)
                                    (+ 3 I))
                         (LIST* (CONS (+ 2 I)
                                      (MAJ (LOOKUP (CAR A) ALIST)
                                           (LOOKUP (CAR B) ALIST)
                                           (XOR (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST))))
                                (CONS (+ 1 I)
                                      (XOR (LOOKUP (CAR A) ALIST)
                                           (XOR (LOOKUP (CAR B) ALIST)
                                                (LOOKUP C ALIST))))
                                (CONS I
                                      (XOR (LOOKUP (CAR B) ALIST)
                                           (LOOKUP C ALIST)))
                                ALIST))
                (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                              (LOOKUP-ALL (CDR B) ALIST)
                              (MAJ (LOOKUP (CAR A) ALIST)
                                   (LOOKUP (CAR B) ALIST)
                                   (LOOKUP C ALIST))))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1/2.2
(IMPLIES (AND (CONSP A)
              (<= (+ 3 I) (+ 2 I))
              (SYMBOLP (CAR A))
              (SYMBOL-LISTP (CDR A))
              (CONSP B)
              (SYMBOLP (CAR B))
              (SYMBOL-LISTP (CDR B))
              (EQUAL (LEN (CDR A)) (LEN (CDR B)))
              (INTEGERP I)
              (SYMBOLP C))
         (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
                (CONS (XOR (LOOKUP (CAR A) ALIST)
                           (XOR (LOOKUP (CAR B) ALIST)
                                (LOOKUP C ALIST)))
                      (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                                    (LOOKUP-ALL (CDR B) ALIST)
                                    (MAJ (LOOKUP (CAR A) ALIST)
                                         (LOOKUP (CAR B) ALIST)
                                         (LOOKUP C ALIST)))))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1/2.1
(IMPLIES (AND (CONSP A)
              (<= (+ 3 I) (+ 2 I))
              (SYMBOLP (CAR A))
              (SYMBOL-LISTP (CDR A))
              (CONSP B)
              (SYMBOLP (CAR B))
              (SYMBOL-LISTP (CDR B))
              (EQUAL (LEN (CDR A)) (LEN (CDR B)))
              (INTEGERP I)
              (INTEGERP C)
              (< C I))
         (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
                (CONS (XOR (LOOKUP (CAR A) ALIST)
                           (XOR (LOOKUP (CAR B) ALIST)
                                (LOOKUP C ALIST)))
                      (SERIAL-ADDER (LOOKUP-ALL (CDR A) ALIST)
                                    (LOOKUP-ALL (CDR B) ALIST)
                                    (MAJ (LOOKUP (CAR A) ALIST)
                                         (LOOKUP (CAR B) ALIST)
                                         (LOOKUP C ALIST)))))).

But simplification reduces this to T, using linear arithmetic.

Subgoal *1/1
(IMPLIES (ENDP A)
         (IMPLIES (AND (SYMBOL-LISTP A)
                       (SYMBOL-LISTP B)
                       (EQUAL (LEN A) (LEN B))
                       (INTEGERP I)
                       (OR (SYMBOLP C)
                           (AND (INTEGERP C) (< C I))))
                  (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
                         (SERIAL-ADDER (LOOKUP-ALL A ALIST)
                                       (LOOKUP-ALL B ALIST)
                                       (LOOKUP C ALIST))))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (AND (NOT (CONSP A))
              (SYMBOL-LISTP A)
              (SYMBOL-LISTP B)
              (EQUAL (LEN A) (LEN B))
              (INTEGERP I)
              (OR (SYMBOLP C)
                  (AND (INTEGERP C) (< C I))))
         (EQUAL (NET-VAL (ADDER-NET A B C I) ALIST)
                (SERIAL-ADDER (LOOKUP-ALL A ALIST)
                              (LOOKUP-ALL B ALIST)
                              (LOOKUP C ALIST)))).

But simplification reduces this to T, using the :definitions ADDER-
NET, ATOM, BIND, EVALUATE-GATE, LOOKUP-ALL, NET-VAL, SERIAL-ADDER and
SYMBOL-LISTP, the :executable-counterparts of CAR, CONSP, EQUAL and
LEN, primitive type reasoning, the :forward-chaining rule SYMBOL-LISTP-
FORWARD-TO-TRUE-LISTP, the :rewrite rules CAR-CONS, CDR-CONS and EQUAL-
LEN-0 and the :type-prescription rule SYMBOL-LISTP.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM ADDER-NET-IS-SERIAL-ADDER ...)
Rules: ((:DEFINITION ADDER-NET)
        (:DEFINITION ATOM)
        (:DEFINITION BIND)
        (:DEFINITION ENDP)
        (:DEFINITION EVALUATE-GATE)
        (:DEFINITION FIX)
        (:DEFINITION FULL-ADDER)
        (:DEFINITION IMPLIES)
        (:DEFINITION LEN)
        (:DEFINITION LOOKUP)
        (:DEFINITION LOOKUP-ALL)
        (:DEFINITION MV-NTH)
        (:DEFINITION NET-VAL)
        (:DEFINITION NOT)
        (:DEFINITION SERIAL-ADDER)
        (:DEFINITION SYMBOL-LISTP)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART LEN)
        (:EXECUTABLE-COUNTERPART SYMBOL-LISTP)
        (:EXECUTABLE-COUNTERPART ZP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:FORWARD-CHAINING SYMBOL-LISTP-FORWARD-TO-TRUE-LISTP)
        (:REWRITE APPEND-RIGHT-ID)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE CONS-EQUAL)
        (:REWRITE EQUAL-LEN-0)
        (:REWRITE INPUT-LOOKUP-ALL-NOT-CHANGED)
        (:REWRITE LEFT-CANCELLATION-FOR-+)
        (:REWRITE TRUE-LISTP-ADDER-NET)
        (:TYPE-PRESCRIPTION LEN)
        (:TYPE-PRESCRIPTION LOOKUP-ALL)
        (:TYPE-PRESCRIPTION SYMBOL-LISTP))
Warnings:  None
Time:  5.49 seconds (prove: 5.25, print: 0.18, other: 0.06)
 ADDER-NET-IS-SERIAL-ADDER
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm adder-net-is-correct
         (implies (and (symbol-listp a)
                       (symbol-listp b)
                       (equal (len a) (len b))
                       (integerp i)
                       (or (symbolp c)
                           (and (integerp c)
                                (< c i))))
                  (equal (n (net-val (adder-net a b c i) alist))
                         (+ (n (lookup-all a alist))
                            (n (lookup-all b alist))
                            (if (lookup c alist) 1 0)))))

This is main theorem. It says that adder-net adds in the arithmetic sense.

More precisely, it says that adder-net generates a netlist whose value is the arithmetic sum of the values of the inputs. The proof is straightforward given what we have already proved. Click on the next link and see. But then read the proof and our commentary afterwards, because what we say there is important. You'll have to scroll to get to our commentary.


[top] [prev] [next]

ACL2 !>(defthm adder-net-is-correct
         (implies (and (symbol-listp a)
                       (symbol-listp b)
                       (equal (len a) (len b))
                       (integerp i)
                       (or (symbolp c)
                           (and (integerp c)
                                (< c i))))
                  (equal (n (net-val (adder-net a b c i) alist))
                         (+ (n (lookup-all a alist))
                            (n (lookup-all b alist))
                            (if (lookup c alist) 1 0)))))

But simplification reduces this to T, using primitive type reasoning,
the :rewrite rules ADDER-NET-IS-SERIAL-ADDER and SERIAL-ADDER-CORRECT
and the :type-prescription rule SYMBOL-LISTP.

Q.E.D.

Summary
Form:  ( DEFTHM ADDER-NET-IS-CORRECT ...)
Rules: ((:DEFINITION IMPLIES)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE ADDER-NET-IS-SERIAL-ADDER)
        (:REWRITE SERIAL-ADDER-CORRECT)
        (:TYPE-PRESCRIPTION SYMBOL-LISTP))
Warnings:  None
Time:  0.13 seconds (prove: 0.11, print: 0.00, other: 0.02)
 ADDER-NET-IS-CORRECT
ACL2 !>

We have dealt with three layers of abstraction in this problem. Each layer is characterized by certain kinds of objects: netlists, bit vectors, and numbers. The abstraction function net-val relates the first to the second, i.e., netlists to bit vectors. The abstraction function n relates the second to the third: bit vectors to numbers. We proved a lemma about each. The composition of the two lemmas, described in the proof above, gives us the desired result, which relates adder-net to natural number arithmetic.

Such a decomposition is not deep; indeed, the problem is just the opposite: it is so second-nature to programmers and designers that it is often overlooked. Look at the name we used for one of our lemmas: ADDER-NET-IS-SERIAL-ADDER. Wrong. Adder-net is not serial-adder. They're only the same when seen through the abstraction net-val. The object produced by adder-net isn't even a bit vector, it is a netlist.

To prove hardware and software correct, it is necessary to make explicit such layers of decomposition.

This gives us an excuse to make another point: Is the theorem just proved an example of hardware verification or software verification? Oddly enough, the most hardware oriented part of it, namely dealing with netlists, is also the most software oriented part of it, because the netlists are being generated by software and the semantics of everything in sight is given by software. What programming language is used? Lisp, or more accurately, ACL2, is used to describe everything. So perhaps this is just an example of Lisp software verification. But it clearly has value to the hardware designer -- or it would if we tackled more interesting problems. Furthermore, the netlist description language is also a programming language. Net-val can be thought of as the semantics of that language and this is a software verification problem about programs in the netlist description language.

The main point is this: in realistic settings, verification problems involve many layers of abstractions and several different languages and systems. To deal with that you need a general-purpose language to describe the myriad special-purpose languages used routinely. ACL2, while limited in many respects, inherits from Lisp great flexibility and convenience in modeling other systems.

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(adder-net 
         '(a00 a01 a02 a03 a04 a05 a06 a07 a08 a09
           a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
           a20 a21 a22 a23 a24 a25 a26 a27 a28 a29
           a30 a31 a32 a33 a34 a35 a36 a37 a38 a39
           a40 a41 a42 a43 a44 a45 a46 a47 a48 a49
           a50 a51 a52 a53 a54 a55 a56 a57 a58 a59
           a60 a61 a62 a63 a64 a65 a66 a67 a68 a69
           a70 a71 a72 a73 a74 a75 a76 a77 a78 a79
           a80 a81 a82 a83 a84 a85 a86 a87 a88 a89
           a90 a91 a92 a93 a94 a95 a96 a97 a98 a99)
         '(b00 b01 b02 b03 b04 b05 b06 b07 b08 b09
           b10 b11 b12 b13 b14 b15 b16 b17 b18 b19
           b20 b21 b22 b23 b24 b25 b26 b27 b28 b29
           b30 b31 b32 b33 b34 b35 b36 b37 b38 b39
           b40 b41 b42 b43 b44 b45 b46 b47 b48 b49
           b50 b51 b52 b53 b54 b55 b56 b57 b58 b59
           b60 b61 b62 b63 b64 b65 b66 b67 b68 b69
           b70 b71 b72 b73 b74 b75 b76 b77 b78 b79
           b80 b81 b82 b83 b84 b85 b86 b87 b88 b89
           b90 b91 b92 b93 b94 b95 b96 b97 b98 b99)
         'c
         0)

To finish things off, let's generate a big adder. This expression, when evaluated, will generate a 100-bit wide adder that we know is correct because we have verified the generator!


[top] [prev] [next]

ACL2 !>(adder-net 
         '(a00 a01 a02 a03 a04 a05 a06 a07 a08 a09
           a10 a11 a12 a13 a14 a15 a16 a17 a18 a19
           a20 a21 a22 a23 a24 a25 a26 a27 a28 a29
           a30 a31 a32 a33 a34 a35 a36 a37 a38 a39
           a40 a41 a42 a43 a44 a45 a46 a47 a48 a49
           a50 a51 a52 a53 a54 a55 a56 a57 a58 a59
           a60 a61 a62 a63 a64 a65 a66 a67 a68 a69
           a70 a71 a72 a73 a74 a75 a76 a77 a78 a79
           a80 a81 a82 a83 a84 a85 a86 a87 a88 a89
           a90 a91 a92 a93 a94 a95 a96 a97 a98 a99)
         '(b00 b01 b02 b03 b04 b05 b06 b07 b08 b09
           b10 b11 b12 b13 b14 b15 b16 b17 b18 b19
           b20 b21 b22 b23 b24 b25 b26 b27 b28 b29
           b30 b31 b32 b33 b34 b35 b36 b37 b38 b39
           b40 b41 b42 b43 b44 b45 b46 b47 b48 b49
           b50 b51 b52 b53 b54 b55 b56 b57 b58 b59
           b60 b61 b62 b63 b64 b65 b66 b67 b68 b69
           b70 b71 b72 b73 b74 b75 b76 b77 b78 b79
           b80 b81 b82 b83 b84 b85 b86 b87 b88 b89
           b90 b91 b92 b93 b94 b95 b96 b97 b98 b99)
         'c
         0)
((0 (XOR B00 C))
 (1 (XOR A00 0) *)
 (2 (MAJ A00 B00 C))
 (3 (XOR B01 2))
 (4 (XOR A01 3) *)
 (5 (MAJ A01 B01 2))
 (6 (XOR B02 5))
 (7 (XOR A02 6) *)
 (8 (MAJ A02 B02 5))
 (9 (XOR B03 8))
 (10 (XOR A03 9) *)
 (11 (MAJ A03 B03 8))
 (12 (XOR B04 11))
 (13 (XOR A04 12) *)
 (14 (MAJ A04 B04 11))
 (15 (XOR B05 14))
 (16 (XOR A05 15) *)
 (17 (MAJ A05 B05 14))
 (18 (XOR B06 17))
 (19 (XOR A06 18) *)
 (20 (MAJ A06 B06 17))
 (21 (XOR B07 20))
 (22 (XOR A07 21) *)
 (23 (MAJ A07 B07 20))
 (24 (XOR B08 23))
 (25 (XOR A08 24) *)
 (26 (MAJ A08 B08 23))
 (27 (XOR B09 26))
 (28 (XOR A09 27) *)
 (29 (MAJ A09 B09 26))
 (30 (XOR B10 29))
 (31 (XOR A10 30) *)
 (32 (MAJ A10 B10 29))
 (33 (XOR B11 32))
 (34 (XOR A11 33) *)
 (35 (MAJ A11 B11 32))
 (36 (XOR B12 35))
 (37 (XOR A12 36) *)
 (38 (MAJ A12 B12 35))
 (39 (XOR B13 38))
 (40 (XOR A13 39) *)
 (41 (MAJ A13 B13 38))
 (42 (XOR B14 41))
 (43 (XOR A14 42) *)
 (44 (MAJ A14 B14 41))
 (45 (XOR B15 44))
 (46 (XOR A15 45) *)
 (47 (MAJ A15 B15 44))
 (48 (XOR B16 47))
 (49 (XOR A16 48) *)
 (50 (MAJ A16 B16 47))
 (51 (XOR B17 50))
 (52 (XOR A17 51) *)
 (53 (MAJ A17 B17 50))
 (54 (XOR B18 53))
 (55 (XOR A18 54) *)
 (56 (MAJ A18 B18 53))
 (57 (XOR B19 56))
 (58 (XOR A19 57) *)
 (59 (MAJ A19 B19 56))
 (60 (XOR B20 59))
 (61 (XOR A20 60) *)
 (62 (MAJ A20 B20 59))
 (63 (XOR B21 62))
 (64 (XOR A21 63) *)
 (65 (MAJ A21 B21 62))
 (66 (XOR B22 65))
 (67 (XOR A22 66) *)
 (68 (MAJ A22 B22 65))
 (69 (XOR B23 68))
 (70 (XOR A23 69) *)
 (71 (MAJ A23 B23 68))
 (72 (XOR B24 71))
 (73 (XOR A24 72) *)
 (74 (MAJ A24 B24 71))
 (75 (XOR B25 74))
 (76 (XOR A25 75) *)
 (77 (MAJ A25 B25 74))
 (78 (XOR B26 77))
 (79 (XOR A26 78) *)
 (80 (MAJ A26 B26 77))
 (81 (XOR B27 80))
 (82 (XOR A27 81) *)
 (83 (MAJ A27 B27 80))
 (84 (XOR B28 83))
 (85 (XOR A28 84) *)
 (86 (MAJ A28 B28 83))
 (87 (XOR B29 86))
 (88 (XOR A29 87) *)
 (89 (MAJ A29 B29 86))
 (90 (XOR B30 89))
 (91 (XOR A30 90) *)
 (92 (MAJ A30 B30 89))
 (93 (XOR B31 92))
 (94 (XOR A31 93) *)
 (95 (MAJ A31 B31 92))
 (96 (XOR B32 95))
 (97 (XOR A32 96) *)
 (98 (MAJ A32 B32 95))
 (99 (XOR B33 98))
 (100 (XOR A33 99) *)
 (101 (MAJ A33 B33 98))
 (102 (XOR B34 101))
 (103 (XOR A34 102) *)
 (104 (MAJ A34 B34 101))
 (105 (XOR B35 104))
 (106 (XOR A35 105) *)
 (107 (MAJ A35 B35 104))
 (108 (XOR B36 107))
 (109 (XOR A36 108) *)
 (110 (MAJ A36 B36 107))
 (111 (XOR B37 110))
 (112 (XOR A37 111) *)
 (113 (MAJ A37 B37 110))
 (114 (XOR B38 113))
 (115 (XOR A38 114) *)
 (116 (MAJ A38 B38 113))
 (117 (XOR B39 116))
 (118 (XOR A39 117) *)
 (119 (MAJ A39 B39 116))
 (120 (XOR B40 119))
 (121 (XOR A40 120) *)
 (122 (MAJ A40 B40 119))
 (123 (XOR B41 122))
 (124 (XOR A41 123) *)
 (125 (MAJ A41 B41 122))
 (126 (XOR B42 125))
 (127 (XOR A42 126) *)
 (128 (MAJ A42 B42 125))
 (129 (XOR B43 128))
 (130 (XOR A43 129) *)
 (131 (MAJ A43 B43 128))
 (132 (XOR B44 131))
 (133 (XOR A44 132) *)
 (134 (MAJ A44 B44 131))
 (135 (XOR B45 134))
 (136 (XOR A45 135) *)
 (137 (MAJ A45 B45 134))
 (138 (XOR B46 137))
 (139 (XOR A46 138) *)
 (140 (MAJ A46 B46 137))
 (141 (XOR B47 140))
 (142 (XOR A47 141) *)
 (143 (MAJ A47 B47 140))
 (144 (XOR B48 143))
 (145 (XOR A48 144) *)
 (146 (MAJ A48 B48 143))
 (147 (XOR B49 146))
 (148 (XOR A49 147) *)
 (149 (MAJ A49 B49 146))
 (150 (XOR B50 149))
 (151 (XOR A50 150) *)
 (152 (MAJ A50 B50 149))
 (153 (XOR B51 152))
 (154 (XOR A51 153) *)
 (155 (MAJ A51 B51 152))
 (156 (XOR B52 155))
 (157 (XOR A52 156) *)
 (158 (MAJ A52 B52 155))
 (159 (XOR B53 158))
 (160 (XOR A53 159) *)
 (161 (MAJ A53 B53 158))
 (162 (XOR B54 161))
 (163 (XOR A54 162) *)
 (164 (MAJ A54 B54 161))
 (165 (XOR B55 164))
 (166 (XOR A55 165) *)
 (167 (MAJ A55 B55 164))
 (168 (XOR B56 167))
 (169 (XOR A56 168) *)
 (170 (MAJ A56 B56 167))
 (171 (XOR B57 170))
 (172 (XOR A57 171) *)
 (173 (MAJ A57 B57 170))
 (174 (XOR B58 173))
 (175 (XOR A58 174) *)
 (176 (MAJ A58 B58 173))
 (177 (XOR B59 176))
 (178 (XOR A59 177) *)
 (179 (MAJ A59 B59 176))
 (180 (XOR B60 179))
 (181 (XOR A60 180) *)
 (182 (MAJ A60 B60 179))
 (183 (XOR B61 182))
 (184 (XOR A61 183) *)
 (185 (MAJ A61 B61 182))
 (186 (XOR B62 185))
 (187 (XOR A62 186) *)
 (188 (MAJ A62 B62 185))
 (189 (XOR B63 188))
 (190 (XOR A63 189) *)
 (191 (MAJ A63 B63 188))
 (192 (XOR B64 191))
 (193 (XOR A64 192) *)
 (194 (MAJ A64 B64 191))
 (195 (XOR B65 194))
 (196 (XOR A65 195) *)
 (197 (MAJ A65 B65 194))
 (198 (XOR B66 197))
 (199 (XOR A66 198) *)
 (200 (MAJ A66 B66 197))
 (201 (XOR B67 200))
 (202 (XOR A67 201) *)
 (203 (MAJ A67 B67 200))
 (204 (XOR B68 203))
 (205 (XOR A68 204) *)
 (206 (MAJ A68 B68 203))
 (207 (XOR B69 206))
 (208 (XOR A69 207) *)
 (209 (MAJ A69 B69 206))
 (210 (XOR B70 209))
 (211 (XOR A70 210) *)
 (212 (MAJ A70 B70 209))
 (213 (XOR B71 212))
 (214 (XOR A71 213) *)
 (215 (MAJ A71 B71 212))
 (216 (XOR B72 215))
 (217 (XOR A72 216) *)
 (218 (MAJ A72 B72 215))
 (219 (XOR B73 218))
 (220 (XOR A73 219) *)
 (221 (MAJ A73 B73 218))
 (222 (XOR B74 221))
 (223 (XOR A74 222) *)
 (224 (MAJ A74 B74 221))
 (225 (XOR B75 224))
 (226 (XOR A75 225) *)
 (227 (MAJ A75 B75 224))
 (228 (XOR B76 227))
 (229 (XOR A76 228) *)
 (230 (MAJ A76 B76 227))
 (231 (XOR B77 230))
 (232 (XOR A77 231) *)
 (233 (MAJ A77 B77 230))
 (234 (XOR B78 233))
 (235 (XOR A78 234) *)
 (236 (MAJ A78 B78 233))
 (237 (XOR B79 236))
 (238 (XOR A79 237) *)
 (239 (MAJ A79 B79 236))
 (240 (XOR B80 239))
 (241 (XOR A80 240) *)
 (242 (MAJ A80 B80 239))
 (243 (XOR B81 242))
 (244 (XOR A81 243) *)
 (245 (MAJ A81 B81 242))
 (246 (XOR B82 245))
 (247 (XOR A82 246) *)
 (248 (MAJ A82 B82 245))
 (249 (XOR B83 248))
 (250 (XOR A83 249) *)
 (251 (MAJ A83 B83 248))
 (252 (XOR B84 251))
 (253 (XOR A84 252) *)
 (254 (MAJ A84 B84 251))
 (255 (XOR B85 254))
 (256 (XOR A85 255) *)
 (257 (MAJ A85 B85 254))
 (258 (XOR B86 257))
 (259 (XOR A86 258) *)
 (260 (MAJ A86 B86 257))
 (261 (XOR B87 260))
 (262 (XOR A87 261) *)
 (263 (MAJ A87 B87 260))
 (264 (XOR B88 263))
 (265 (XOR A88 264) *)
 (266 (MAJ A88 B88 263))
 (267 (XOR B89 266))
 (268 (XOR A89 267) *)
 (269 (MAJ A89 B89 266))
 (270 (XOR B90 269))
 (271 (XOR A90 270) *)
 (272 (MAJ A90 B90 269))
 (273 (XOR B91 272))
 (274 (XOR A91 273) *)
 (275 (MAJ A91 B91 272))
 (276 (XOR B92 275))
 (277 (XOR A92 276) *)
 (278 (MAJ A92 B92 275))
 (279 (XOR B93 278))
 (280 (XOR A93 279) *)
 (281 (MAJ A93 B93 278))
 (282 (XOR B94 281))
 (283 (XOR A94 282) *)
 (284 (MAJ A94 B94 281))
 (285 (XOR B95 284))
 (286 (XOR A95 285) *)
 (287 (MAJ A95 B95 284))
 (288 (XOR B96 287))
 (289 (XOR A96 288) *)
 (290 (MAJ A96 B96 287))
 (291 (XOR B97 290))
 (292 (XOR A97 291) *)
 (293 (MAJ A97 B97 290))
 (294 (XOR B98 293))
 (295 (XOR A98 294) *)
 (296 (MAJ A98 B98 293))
 (297 (XOR B99 296))
 (298 (XOR A99 297) *)
 (299 (MAJ A99 B99 296))
 (300 299 *))
ACL2 !>

We could have just as easily generated a correct 1000-bit adder, without doing any more proofs.

[top] [prev] [next]


[top] [prev] [next]

A Simple Stack Machine and Expression Compiler

Next we define a stack machine and simple compiler. The plan is as follows.

Define the semantics of the instructions
- (LOAD var) -- push the value of var on the stack.
- (PUSH const) -- push the constant const on the stack,
- (DUP) -- duplicate the top of the stack.
- (ADD) -- add the top two items on the stack.
- (MUL) -- multiply the top two items on the stack.
Define a machine to execute a sequence of such instructions.
Define a simple expression language containing such expressions as (sq (inc (a + (3 * b)))), where sq and inc are square and increment-by-1, respectively.
Write a compiler that compiles such expressions into programs for our machine.
Specify and prove the compiler correct.


[top] [prev] [next]

ACL2 !>(defun execute (instr alist stk)
        (let ((op (car instr)))
          (cond
           ((equal op 'load)
            (push-stack (lookup (cadr instr) alist) stk))
           ((equal op 'push)
            (push-stack (cadr instr) stk))
           ((equal op 'dup)
            (push-stack (top-stack stk) stk))
           ((equal op 'add)
            (push-stack (+ (top-stack (pop-stack stk)) (top-stack stk))
                        (pop-stack (pop-stack stk))))
           ((equal op 'mul)
            (push-stack (* (top-stack (pop-stack stk)) (top-stack stk))
                        (pop-stack (pop-stack stk))))
           (t stk))))

This function defines the semantics of each instruction. Rather than read it now, just admit it by clicking on the next link and then look at the examples of its behavior. You might then come back to read it if you wish.


[top] [prev] [next]

ACL2 !>(defun execute (instr alist stk)
        (let ((op (car instr)))
          (cond
           ((equal op 'load)
            (push-stack (lookup (cadr instr) alist) stk))
           ((equal op 'push)
            (push-stack (cadr instr) stk))
           ((equal op 'dup)
            (push-stack (top-stack stk) stk))
           ((equal op 'add)
            (push-stack (+ (top-stack (pop-stack stk)) (top-stack stk))
                        (pop-stack (pop-stack stk))))
           ((equal op 'mul)
            (push-stack (* (top-stack (pop-stack stk)) (top-stack stk))
                        (pop-stack (pop-stack stk))))
           (t stk))))

Since EXECUTE is non-recursive, its admission is trivial.  We observe
that the type of EXECUTE is described by the theorem 
(OR (CONSP (EXECUTE INSTR ALIST STK)) (EQUAL (EXECUTE INSTR ALIST STK) STK)).
We used the :type-prescription rule PUSH-STACK.

Summary
Form:  ( DEFUN EXECUTE ...)
Rules: ((:TYPE-PRESCRIPTION PUSH-STACK))
Warnings:  None
Time:  0.02 seconds (prove: 0.00, print: 0.00, other: 0.02)
 EXECUTE
ACL2 !>


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))

We will now show examples of each instruction, starting with

(LOAD
var)

Above you see a LOAD instruction for the variable A, in an environment where A has value 7 and B has value 4. The initial stack has a 3 on top, followed by a 2, and a 1. The function execute, just defined, returns the stack produced by executing the given instruction.

LOAD pushes the value of its operand (a variable name) onto the stack. Watch.


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))

PUSH pushes its operand.


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))

DUP duplicates the top of the stack.


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))
(3 3 2 1)
ACL2 !>


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))
(3 3 2 1)
ACL2 !>(execute '(ADD)     '((A . 7) (B . 4))   '(3 2 1))

ADD adds the top two items on the stack and pushes the result in their place.


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))
(3 3 2 1)
ACL2 !>(execute '(ADD)     '((A . 7) (B . 4))   '(3 2 1))
(5 1)
ACL2 !>


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))
(3 3 2 1)
ACL2 !>(execute '(ADD)     '((A . 7) (B . 4))   '(3 2 1))
(5 1)
ACL2 !>(execute '(MUL)     '((A . 7) (B . 4))   '(3 2 1))

MUL multiplies the top two items on the stack and pushes the result in their place.


[top] [prev] [next]

ACL2 !>(execute '(LOAD A)  '((A . 7) (B . 4))   '(3 2 1))
(7 3 2 1)
ACL2 !>(execute '(PUSH A)  '((A . 7) (B . 4))   '(3 2 1))
(A 3 2 1)
ACL2 !>(execute '(DUP)     '((A . 7) (B . 4))   '(3 2 1))
(3 3 2 1)
ACL2 !>(execute '(ADD)     '((A . 7) (B . 4))   '(3 2 1))
(5 1)
ACL2 !>(execute '(MUL)     '((A . 7) (B . 4))   '(3 2 1))
(6 1)
ACL2 !>

So we have instructions for a fairly conventional push down stack machine here. We could clearly code the instructions more ``concretely,'' as lists with numeric opcodes and operands, or as packed integers, or as concatenations of fixed-width bit vectors for each field, etc. What we have chosen is an ``assembly language'' view of the machine.


[top] [prev] [next]

ACL2 !>(defun m (program alist stk)
         (cond ((endp program) stk)
               ((m (cdr program)
                   alist
                   (execute (car program) alist stk)))))

Here is a ``machine'' that executes the instructions in a program.


[top] [prev] [next]

ACL2 !>(defun m (program alist stk)
         (cond ((endp program) stk)
               ((m (cdr program)
                   alist
                   (execute (car program) alist stk)))))

The admission of M is trivial, using the relation E0-ORD-< (which is
known to be well-founded on the domain recognized by E0-ORDINALP) and
the measure (ACL2-COUNT PROGRAM).  We could deduce no constraints on
the type of M.

Summary
Form:  ( DEFUN M ...)
Rules: NIL
Warnings:  None
Time:  0.01 seconds (prove: 0.00, print: 0.01, other: 0.00)
 M
ACL2 !>


[top] [prev] [next]

ACL2 !>(m '((LOAD A) (DUP) (ADD)) '((A . 7) (B . 4))  '(0 0 0))

This program loads the value of A on the stack, duplicates the top of the stack, and adds together the top two items. The value of A is 7 and the initial stack contains three zeros. What is the final stack?


[top] [prev] [next]

ACL2 !>(m '((LOAD A) (DUP) (ADD)) '((A . 7) (B . 4))  '(0 0 0))
(14 0 0 0)
ACL2 !>


[top] [prev] [next]

ACL2 !>(defun evaluate (x alist)
         (cond
          ((atom x)
           (cond ((symbolp x) (lookup x alist))
                 (t x)))
          ((equal (len x) 2)
           (cond
            ((equal (car x) 'inc)
             (+ 1 (evaluate (cadr x) alist)))
            ((equal (car x) 'sq)
             (* (evaluate (cadr x) alist)
                (evaluate (cadr x) alist)))
            (t 0)))
          ((equal (cadr x) '+)
           (+ (evaluate (car x) alist)
              (evaluate (caddr x) alist)))
          ((equal (cadr x) '*)
           (* (evaluate (car x) alist)
              (evaluate (caddr x) alist)))
          (t 0)))

This function defines the semantics of a simple expression language consisting of variables, constants, calls of the unary functions inc (increment) and sq (square) and the binary function + and *. Binary operators are written in infix position. Admission of the function is tedious. We recommend not reading the admission proof.


[top] [prev] [next]

ACL2 !>(defun evaluate (x alist)
         (cond
          ((atom x)
           (cond ((symbolp x) (lookup x alist))
                 (t x)))
          ((equal (len x) 2)
           (cond
            ((equal (car x) 'inc)
             (+ 1 (evaluate (cadr x) alist)))
            ((equal (car x) 'sq)
             (* (evaluate (cadr x) alist)
                (evaluate (cadr x) alist)))
            (t 0)))
          ((equal (cadr x) '+)
           (+ (evaluate (car x) alist)
              (evaluate (caddr x) alist)))
          ((equal (cadr x) '*)
           (* (evaluate (car x) alist)
              (evaluate (caddr x) alist)))
          (t 0)))

For the admission of EVALUATE we will use the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  The non-trivial part of the measure
conjecture is

Goal
(AND (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQUAL (CAR X) 'SQ))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQUAL (CADR X) '+))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQUAL (CADR X) '*))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQUAL (CAR X) 'INC))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))).

By the simple :definition ATOM we reduce the conjecture to the following
four conjectures.

Subgoal 4
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'SQ))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 4'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'SQ))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 4.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 4.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 4.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 3
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '+))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 3'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 3''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 3.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 3.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 3.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 2
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '*))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 2'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 2''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 2.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 2.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 2.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'INC))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 1'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'INC))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 1.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 1.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 1.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Q.E.D.

That completes the proof of the measure theorem for EVALUATE.  Thus,
we admit this function under the principle of definition. We could
deduce no constraints on the type of EVALUATE.

Summary
Form:  ( DEFUN EVALUATE ...)
Rules: ((:DEFINITION ACL2-COUNT)
        (:DEFINITION ATOM)
        (:DEFINITION E0-ORD-<)
        (:DEFINITION FIX)
        (:DEFINITION LEN)
        (:DEFINITION NOT)
        (:DEFINITION SYNTAXP)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ACL2-COUNT)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART NOT)
        (:EXECUTABLE-COUNTERPART SYMBOLP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION ACL2-COUNT))
Warnings:  None
Time:  1.04 seconds (prove: 0.85, print: 0.13, other: 0.06)
 EVALUATE
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(evaluate '((3 * b) + a)   '((a . 7) (b . 4)))

So what's the value of ((3 * b) + a) when b is 4 and a is 7?


[top] [prev] [next]

ACL2 !>(evaluate '((3 * b) + a)   '((a . 7) (b . 4)))
19
ACL2 !>


[top] [prev] [next]

ACL2 !>(evaluate '((3 * b) + a)   '((a . 7) (b . 4)))
19
ACL2 !>(m '((PUSH 3) (LOAD B) (MUL) (LOAD A) (ADD)) '((a . 7) (b . 4)) nil)

What does the above program compute? Where does it leave the answer?


[top] [prev] [next]

ACL2 !>(evaluate '((3 * b) + a)   '((a . 7) (b . 4)))
19
ACL2 !>(m '((PUSH 3) (LOAD B) (MUL) (LOAD A) (ADD)) '((a . 7) (b . 4)) nil)
(19)
ACL2 !>

The program above leaves the value of the expression above on the top of the stack. This suggests how we might compile expressions.


[top] [prev] [next]

ACL2 !>(defun compile-expression (x)
         (cond
          ((atom x)
           (cond
            ((symbolp x) (list (list 'load x)))
            (t (list (list 'push x)))))
          ((equal (len x) 2)
           (cond
            ((eq (car x) 'inc)
             (append (compile-expression (cadr x))
                     '((push 1) (add))))
            ((eq (car x) 'sq)
             (append (compile-expression (cadr x))
                     '((dup) (mul))))
            (t (list (list 'push 0)))))
          ((eq (cadr x) '+)
           (append (compile-expression (car x))
                   (compile-expression (caddr x))
                   '((add))))
          ((eq (cadr x) '*)
           (append (compile-expression (car x))
                   (compile-expression (caddr x))
                   '((mul))))
          (t (list (list 'push 0)))))

Here is the obvious compiler. Admission is tedious. But read the definition above.


[top] [prev] [next]

ACL2 !>(defun compile-expression (x)
         (cond
          ((atom x)
           (cond
            ((symbolp x) (list (list 'load x)))
            (t (list (list 'push x)))))
          ((equal (len x) 2)
           (cond
            ((eq (car x) 'inc)
             (append (compile-expression (cadr x))
                     '((push 1) (add))))
            ((eq (car x) 'sq)
             (append (compile-expression (cadr x))
                     '((dup) (mul))))
            (t (list (list 'push 0)))))
          ((eq (cadr x) '+)
           (append (compile-expression (car x))
                   (compile-expression (caddr x))
                   '((add))))
          ((eq (cadr x) '*)
           (append (compile-expression (car x))
                   (compile-expression (caddr x))
                   '((mul))))
          (t (list (list 'push 0)))))

For the admission of COMPILE-EXPRESSION we will use the relation E0-
ORD-< (which is known to be well-founded on the domain recognized by
E0-ORDINALP) and the measure (ACL2-COUNT X).  The non-trivial part
of the measure conjecture is

Goal
(AND (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQ (CAR X) 'SQ))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQ (CADR X) '+))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQ (CADR X) '*))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQ (CAR X) 'INC))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))).

By the simple :definitions ATOM and EQ we reduce the conjecture to
the following four conjectures.

Subgoal 4
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'SQ))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 4'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'SQ))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 4.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 4.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 4.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 3
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '+))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 3'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 3''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 3.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 3.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 3.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 2
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '*))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 2'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 2''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 2.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 2.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 2.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'INC))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 1'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'INC))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 1.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 1.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 1.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Q.E.D.

That completes the proof of the measure theorem for COMPILE-EXPRESSION.
Thus, we admit this function under the principle of definition. We
observe that the type of COMPILE-EXPRESSION is described by the theorem
(CONSP (COMPILE-EXPRESSION X)).  We used primitive type reasoning and
the :type-prescription rule BINARY-APPEND.

Summary
Form:  ( DEFUN COMPILE-EXPRESSION ...)
Rules: ((:DEFINITION ACL2-COUNT)
        (:DEFINITION ATOM)
        (:DEFINITION E0-ORD-<)
        (:DEFINITION EQ)
        (:DEFINITION FIX)
        (:DEFINITION LEN)
        (:DEFINITION NOT)
        (:DEFINITION SYNTAXP)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ACL2-COUNT)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART NOT)
        (:EXECUTABLE-COUNTERPART SYMBOLP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION ACL2-COUNT)
        (:TYPE-PRESCRIPTION BINARY-APPEND))
Warnings:  None
Time:  0.68 seconds (prove: 0.56, print: 0.07, other: 0.05)
 COMPILE-EXPRESSION
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(compile-expression '(SQ (INC (A + (3 * B)))))

What is the compiled code for the expression above?


[top] [prev] [next]

ACL2 !>(compile-expression '(SQ (INC (A + (3 * B)))))
((LOAD A)
 (PUSH 3)
 (LOAD B)
 (MUL)
 (ADD)
 (PUSH 1)
 (ADD)
 (DUP)
 (MUL))
ACL2 !>


[top] [prev] [next]

ACL2 !>(defthm sequential-execution
         (equal (m (append x y) a s)
                (m y a (m x a s))))

We now move toward proving the compiler correct. Here is a key lemma in that proof. The machine executes a sequence of instructions by executing the latter part of the sequence in the state produced by the former part of the sequence.

This lemma will allow the theorem prover to make sense of the instruction sequences the compiler constructs by concatenation.


[top] [prev] [next]

ACL2 !>(defthm sequential-execution
         (equal (m (append x y) a s)
                (m y a (m x a s))))

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 (M X A S), but modified
to accommodate (APPEND X Y).  If we let  (:P A S X Y) denote *1 above
then the induction scheme we'll use is
(AND (IMPLIES (AND (NOT (ENDP X))
                   (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
                   (:P A (EXECUTE (CAR X) A S) (CDR X) Y))
              (:P A S X Y))
     (IMPLIES (AND (NOT (ENDP X))
                   (M (CDR X) A (EXECUTE (CAR X) A S))
                   (:P A (EXECUTE (CAR X) A S) (CDR X) Y))
              (:P A S X Y))
     (IMPLIES (ENDP X) (:P A S X Y))).
This induction is justified by the same argument used to admit M, namely,
the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  Note, however, that the unmeasured variable S is
being instantiated.  When applied to the goal at hand the above induction
scheme produces the following three nontautological subgoals.

Subgoal *1/3
(IMPLIES (AND (NOT (ENDP X))
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (EXECUTE (CAR X) A S))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/3'
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (EXECUTE (CAR X) A S))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

This simplifies, using the :definitions BINARY-APPEND, EXECUTE, FIX,
M, POP-STACK, PUSH-STACK and TOP-STACK, the :executable-counterparts
of BINARY-*, BINARY-+, EQUAL, POP-STACK, PUSH-STACK and TOP-STACK,
primitive type reasoning and the :rewrite rules CAR-CONS, CDR-CONS,
COMMUTATIVITY-OF-*, COMMUTATIVITY-OF-+, DEFAULT-CDR, TIMES-ZERO and
UNICITY-OF-0, to the following five conjectures.

Subgoal *1/3.5
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y A NIL))
              (ACL2-NUMBERP (CAR S)))
         (EQUAL (M (APPEND (CDR X) Y) A (LIST (CAR S)))
                (M Y A NIL))).

But simplification reduces this to T, using the :definition FIX and
the :rewrite rules COMMUTATIVITY-OF-+, DEFAULT-CDR and UNICITY-OF-0.

Subgoal *1/3.4
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y A NIL))
              (NOT (ACL2-NUMBERP (CAR S))))
         (EQUAL (M (APPEND (CDR X) Y) A (LIST 0))
                (M Y A NIL))).

By the :executable-counterpart of CONS we reduce the conjecture to

Subgoal *1/3.4'
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y A NIL))
              (NOT (ACL2-NUMBERP (CAR S))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

But simplification reduces this to T, using the :executable-counterparts
of CONS and FIX and the :rewrite rules DEFAULT-+-1 and DEFAULT-CDR.

Subgoal *1/3.3
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'ADD)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ 0 0) (CDDR S)))
                     (M Y A NIL)))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

By the :executable-counterpart of BINARY-+ we reduce the conjecture
to

Subgoal *1/3.3'
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'ADD)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS 0 (CDDR S)))
                     (M Y A NIL)))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

But simplification reduces this to T, using the :executable-counterparts
of CDR and CONS, primitive type reasoning and the :rewrite rule DEFAULT-
CDR.

Subgoal *1/3.2
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'MUL)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (* (CAR S) 0) (CDDR S)))
                     (M Y A NIL)))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

But simplification reduces this to T, using the :executable-counterpart
of CONS and the :rewrite rules COMMUTATIVITY-OF-*, DEFAULT-CDR and
TIMES-ZERO.

Subgoal *1/3.1
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'MUL)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (* 0 0) (CDDR S)))
                     (M Y A NIL)))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

By the :executable-counterpart of BINARY-* we reduce the conjecture
to

Subgoal *1/3.1'
(IMPLIES (AND (CONSP X)
              (NOT (M (CDR X) A (EXECUTE (CAR X) A S)))
              (EQUAL (CAAR X) 'MUL)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS 0 (CDDR S)))
                     (M Y A NIL)))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M Y A NIL))).

But simplification reduces this to T, using the :executable-counterparts
of CDR and CONS, primitive type reasoning and the :rewrite rule DEFAULT-
CDR.

Subgoal *1/2
(IMPLIES (AND (NOT (ENDP X))
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (EXECUTE (CAR X) A S))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (EXECUTE (CAR X) A S))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

This simplifies, using the :definitions BINARY-APPEND, EXECUTE, FIX,
M, POP-STACK, PUSH-STACK and TOP-STACK, the :executable-counterparts
of BINARY-*, BINARY-+, EQUAL, POP-STACK, PUSH-STACK and TOP-STACK,
primitive type reasoning and the :rewrite rules CAR-CONS, CDR-CONS,
COMMUTATIVITY-OF-*, COMMUTATIVITY-OF-+, DEFAULT-CDR, TIMES-ZERO and
UNICITY-OF-0, to the following five conjectures.

Subgoal *1/2.5
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S))))
              (ACL2-NUMBERP (CAR S)))
         (EQUAL (M (APPEND (CDR X) Y) A (LIST (CAR S)))
                (M (APPEND (CDR X) Y)
                   A (CONS (+ (CAR S) 0) (CDDR S))))).

But simplification reduces this to T, using the :definition FIX, primitive
type reasoning and the :rewrite rules COMMUTATIVITY-OF-+, DEFAULT-CDR
and UNICITY-OF-0.

Subgoal *1/2.4
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S))))
              (NOT (ACL2-NUMBERP (CAR S))))
         (EQUAL (M (APPEND (CDR X) Y) A (LIST 0))
                (M (APPEND (CDR X) Y)
                   A (CONS (+ (CAR S) 0) (CDDR S))))).

By the :executable-counterpart of CONS we reduce the conjecture to

Subgoal *1/2.4'
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'ADD)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ (CAR S) 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S))))
              (NOT (ACL2-NUMBERP (CAR S))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS (+ (CAR S) 0) (CDDR S))))).

But simplification reduces this to T, using the :executable-counterparts
of CONS and FIX, primitive type reasoning and the :rewrite rules DEFAULT-
+-1 and DEFAULT-CDR.

Subgoal *1/2.3
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'ADD)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (+ 0 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS (+ 0 0) (CDDR S))))).

By the :executable-counterpart of BINARY-+ we reduce the conjecture
to

Subgoal *1/2.3'
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'ADD)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS 0 (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS 0 (CDDR S))))).

But simplification reduces this to T, using the :executable-counterparts
of CDR and CONS, primitive type reasoning and the :rewrite rule DEFAULT-
CDR.

Subgoal *1/2.2
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'MUL)
              (CONSP S)
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (* (CAR S) 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS (* (CAR S) 0) (CDDR S))))).

But simplification reduces this to T, using the :executable-counterpart
of CONS, primitive type reasoning and the :rewrite rules COMMUTATIVITY-
OF-*, DEFAULT-CDR and TIMES-ZERO.

Subgoal *1/2.1
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'MUL)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS (* 0 0) (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS (* 0 0) (CDDR S))))).

By the :executable-counterpart of BINARY-* we reduce the conjecture
to

Subgoal *1/2.1'
(IMPLIES (AND (CONSP X)
              (M (CDR X) A (EXECUTE (CAR X) A S))
              (EQUAL (CAAR X) 'MUL)
              (NOT (CONSP S))
              (NOT (CONSP (CDR S)))
              (EQUAL (M (APPEND (CDR X) Y)
                        A (CONS 0 (CDDR S)))
                     (M Y
                        A (M (CDR X) A (EXECUTE (CAR X) A S)))))
         (EQUAL (M (APPEND (CDR X) Y) A '(0))
                (M (APPEND (CDR X) Y)
                   A (CONS 0 (CDDR S))))).

But simplification reduces this to T, using the :executable-counterparts
of CDR and CONS, primitive type reasoning and the :rewrite rule DEFAULT-
CDR.

Subgoal *1/1
(IMPLIES (ENDP X)
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

By the simple :definition ENDP we reduce the conjecture to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (EQUAL (M (APPEND X Y) A S)
                (M Y A (M X A S)))).

But simplification reduces this to T, using the :definitions BINARY-
APPEND and M and primitive type reasoning.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM SEQUENTIAL-EXECUTION ...)
Rules: ((:DEFINITION BINARY-APPEND)
        (:DEFINITION ENDP)
        (:DEFINITION EXECUTE)
        (:DEFINITION FIX)
        (:DEFINITION M)
        (:DEFINITION NOT)
        (:DEFINITION POP-STACK)
        (:DEFINITION PUSH-STACK)
        (:DEFINITION TOP-STACK)
        (:EXECUTABLE-COUNTERPART BINARY-*)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART CONS)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART FIX)
        (:EXECUTABLE-COUNTERPART POP-STACK)
        (:EXECUTABLE-COUNTERPART PUSH-STACK)
        (:EXECUTABLE-COUNTERPART TOP-STACK)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-OF-*)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE DEFAULT-+-1)
        (:REWRITE DEFAULT-CDR)
        (:REWRITE TIMES-ZERO)
        (:REWRITE UNICITY-OF-0))
Warnings:  None
Time:  1.94 seconds (prove: 1.77, print: 0.16, other: 0.01)
 SEQUENTIAL-EXECUTION
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defun hintfn (x a s)
        (cond
         ((atom x) (list x a s))
         ((equal (len x) 2)
          (cond
           ((eq (car x) 'inc)
            (hintfn (cadr x) a s))
           ((eq (car x) 'sq)
            (hintfn (cadr x) a s))
           (t (list x a s))))
         ((eq (cadr x) '+)
          (cons (hintfn (car x) a s)
                (hintfn (caddr x) a (push-stack (evaluate (car x) a) s))))
         ((eq (cadr x) '*)
          (cons (hintfn (car x) a s)
                (hintfn (caddr x) a (push-stack (evaluate (car x) a) s))))
         (t (list x a s))))

This function will be used in the next command to give the theorem prover an explicit ``hint'' as to what induction to perform to prove the compiler correct. The admission is tedious. (By the way, the tedious arguments in this section are all the same. If we wanted to, we could reduce them to one-liners with few lemmas, but we won't bother.)


[top] [prev] [next]

ACL2 !>(defun hintfn (x a s)
        (cond
         ((atom x) (list x a s))
         ((equal (len x) 2)
          (cond
           ((eq (car x) 'inc)
            (hintfn (cadr x) a s))
           ((eq (car x) 'sq)
            (hintfn (cadr x) a s))
           (t (list x a s))))
         ((eq (cadr x) '+)
          (cons (hintfn (car x) a s)
                (hintfn (caddr x) a (push-stack (evaluate (car x) a) s))))
         ((eq (cadr x) '*)
          (cons (hintfn (car x) a s)
                (hintfn (caddr x) a (push-stack (evaluate (car x) a) s))))
         (t (list x a s))))

For the admission of HINTFN we will use the relation E0-ORD-< (which
is known to be well-founded on the domain recognized by E0-ORDINALP)
and the measure (ACL2-COUNT X).  The non-trivial part of the measure
conjecture is

Goal
(AND (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQ (CAR X) 'SQ))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQ (CADR X) '+))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQ (CADR X) '*))
              (E0-ORD-< (ACL2-COUNT (CADDR X))
                        (ACL2-COUNT X)))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQ (CAR X) 'INC))
              (E0-ORD-< (ACL2-COUNT (CADR X))
                        (ACL2-COUNT X)))).

By the simple :definitions ATOM and EQ we reduce the conjecture to
the following four conjectures.

Subgoal 4
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'SQ))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 4'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'SQ))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 4.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 4.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'SQ))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 4.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 3
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '+))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 3'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 3''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 3.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 3.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '+))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 3.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 2
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '*))
         (E0-ORD-< (ACL2-COUNT (CADDR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions E0-ORD-< and LEN, primitive
type reasoning and the :type-prescription rule ACL2-COUNT, to

Subgoal 2'
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

This simplifies, using the :definition SYNTAXP, the :executable-counterparts
of BINARY-+, CAR, CONSP, EQ and IF and the :rewrite rule FOLD-CONSTS-
IN-+, to

Subgoal 2''
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*))
         (< (ACL2-COUNT (CADDR X))
            (ACL2-COUNT X))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of three rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2.  (2) Use CAR-CDR-ELIM, again, to replace
X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and (CDR X2) to X4
and restricting the type of the new variable X3 to be that of the term
it replaces.  (3) Finally, use CAR-CDR-ELIM to replace X4 by (CONS X5 X6),
generalizing (CAR X4) to X5 and (CDR X4) to X6.    These steps produce
the following two goals.

Subgoal 2.2
(IMPLIES (AND (NOT (CONSP X4))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (CONS X3 X4))
              (CONSP (LIST* X1 X3 X4))
              (NOT (EQUAL (+ 2 (LEN X4)) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT (CAR X4))
            (ACL2-COUNT (LIST* X1 X3 X4)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 2.1
(IMPLIES (AND (CONSP (CONS X5 X6))
              (SYMBOLP X3)
              (NOT (EQUAL X3 T))
              X3 (CONSP (LIST* X3 X5 X6))
              (CONSP (LIST* X1 X3 X5 X6))
              (NOT (EQUAL (+ 2 (LEN (CONS X5 X6))) 2))
              (EQUAL X3 '*))
         (< (ACL2-COUNT X5)
            (ACL2-COUNT (LIST* X1 X3 X5 X6)))).

This simplifies, using the :definitions ACL2-COUNT, FIX, LEN and SYNTAXP,
the :executable-counterparts of ACL2-COUNT, BINARY-+, CAR, CONSP, EQ,
EQUAL, IF, NOT and SYMBOLP, primitive type reasoning, the :rewrite
rules CAR-CONS, CDR-CONS, COMMUTATIVITY-2-OF-+, FOLD-CONSTS-IN-+ and
UNICITY-OF-0 and the :type-prescription rule ACL2-COUNT, to

Subgoal 2.1'
(IMPLIES (NOT (EQUAL (+ 3 (LEN X6)) 2))
         (< (ACL2-COUNT X5)
            (+ 3 (ACL2-COUNT X1)
               (ACL2-COUNT X5)
               (ACL2-COUNT X6)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Subgoal 1
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'INC))
         (E0-ORD-< (ACL2-COUNT (CADR X))
                   (ACL2-COUNT X))).

This simplifies, using the :definitions ACL2-COUNT, E0-ORD-<, FIX and
LEN, the :executable-counterpart of ACL2-COUNT, primitive type reasoning,
the :rewrite rule UNICITY-OF-0 and the :type-prescription rule ACL2-
COUNT, to

Subgoal 1'
(IMPLIES (AND (CONSP X)
              (EQUAL (+ 1 (LEN (CDR X))) 2)
              (EQUAL (CAR X) 'INC))
         (< (ACL2-COUNT (CADR X))
            (+ 1 (ACL2-COUNT (CDR X))))).

The destructor terms (CAR X) and (CDR X) can be eliminated.  Furthermore,
those terms are at the root of a chain of two rounds of destructor
elimination. (1) Use CAR-CDR-ELIM to replace X by (CONS X1 X2), generalizing
(CAR X) to X1 and (CDR X) to X2 and restricting the type of the new
variable X1 to be that of the term it replaces.  (2) Use CAR-CDR-ELIM,
again, to replace X2 by (CONS X3 X4), generalizing (CAR X2) to X3 and
(CDR X2) to X4.    These steps produce the following two goals.

Subgoal 1.2
(IMPLIES (AND (NOT (CONSP X2))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (CONS X1 X2))
              (EQUAL (+ 1 (LEN X2)) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT (CAR X2))
            (+ 1 (ACL2-COUNT X2)))).

But simplification reduces this to T, using the :definition LEN, the
:executable-counterparts of BINARY-+, EQUAL, NOT and SYMBOLP and primitive
type reasoning.

Subgoal 1.1
(IMPLIES (AND (CONSP (CONS X3 X4))
              (SYMBOLP X1)
              (NOT (EQUAL X1 T))
              X1 (CONSP (LIST* X1 X3 X4))
              (EQUAL (+ 1 (LEN (CONS X3 X4))) 2)
              (EQUAL X1 'INC))
         (< (ACL2-COUNT X3)
            (+ 1 (ACL2-COUNT (CONS X3 X4))))).

This simplifies, using the :definitions ACL2-COUNT, LEN and SYNTAXP,
the :executable-counterparts of BINARY-+, CAR, CONSP, EQ, EQUAL, IF,
NOT and SYMBOLP, primitive type reasoning and the :rewrite rules CAR-
CONS, CDR-CONS and FOLD-CONSTS-IN-+, to

Subgoal 1.1'
(IMPLIES (EQUAL (+ 2 (LEN X4)) 2)
         (< (ACL2-COUNT X3)
            (+ 2 (ACL2-COUNT X3) (ACL2-COUNT X4)))).

But simplification reduces this to T, using linear arithmetic and the
:type-prescription rule ACL2-COUNT.

Q.E.D.

That completes the proof of the measure theorem for HINTFN.  Thus,
we admit this function under the principle of definition. We observe
that the type of HINTFN is described by the theorem 
(AND (CONSP (HINTFN X A S)) (TRUE-LISTP (HINTFN X A S))).  We used
primitive type reasoning.

Summary
Form:  ( DEFUN HINTFN ...)
Rules: ((:DEFINITION ACL2-COUNT)
        (:DEFINITION ATOM)
        (:DEFINITION E0-ORD-<)
        (:DEFINITION EQ)
        (:DEFINITION FIX)
        (:DEFINITION LEN)
        (:DEFINITION NOT)
        (:DEFINITION SYNTAXP)
        (:ELIM CAR-CDR-ELIM)
        (:EXECUTABLE-COUNTERPART ACL2-COUNT)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART NOT)
        (:EXECUTABLE-COUNTERPART SYMBOLP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-2-OF-+)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE UNICITY-OF-0)
        (:TYPE-PRESCRIPTION ACL2-COUNT))
Warnings:  None
Time:  1.06 seconds (prove: 0.51, print: 0.14, other: 0.41)
 HINTFN
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm key-compiler-lemma
         (equal (m (compile-expression x) a s)
                (push-stack (evaluate x a) s))
         :hints (("Goal" :induct (hintfn x a s))))

This is the fundamental property of the compiler. We may be interested only in the fact that execution of the compiled code leaves the value of the expression on top of the stack. But to prove that we must prove this more general fact: execution of the compiled code pushes the value onto the stack, leaving pre-existing stack items unchanged.


[top] [prev] [next]

ACL2 !>(defthm key-compiler-lemma
         (equal (m (compile-expression x) a s)
                (push-stack (evaluate x a) s))
         :hints (("Goal" :induct (hintfn x a s))))

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

Name the formula above *1.

We have been told to use induction.  One induction scheme is suggested
by the induction hint.  

We will induct according to a scheme suggested by (HINTFN X A S). 
If we let  (:P A S X) denote *1 above then the induction scheme we'll
use is
(AND (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (NOT (EQ (CADR X) '+))
                   (NOT (EQ (CADR X) '*)))
              (:P A S X))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (NOT (EQ (CADR X) '+))
                   (EQ (CADR X) '*)
                   (:P A S (CAR X))
                   (:P A (PUSH-STACK (EVALUATE (CAR X) A) S)
                       (CADDR X)))
              (:P A S X))
     (IMPLIES (AND (NOT (ATOM X))
                   (NOT (EQUAL (LEN X) 2))
                   (EQ (CADR X) '+)
                   (:P A S (CAR X))
                   (:P A (PUSH-STACK (EVALUATE (CAR X) A) S)
                       (CADDR X)))
              (:P A S X))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (NOT (EQ (CAR X) 'INC))
                   (NOT (EQ (CAR X) 'SQ)))
              (:P A S X))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (NOT (EQ (CAR X) 'INC))
                   (EQ (CAR X) 'SQ)
                   (:P A S (CADR X)))
              (:P A S X))
     (IMPLIES (AND (NOT (ATOM X))
                   (EQUAL (LEN X) 2)
                   (EQ (CAR X) 'INC)
                   (:P A S (CADR X)))
              (:P A S X))
     (IMPLIES (ATOM X) (:P A S X))).
This induction is justified by the same argument used to admit HINTFN,
namely, the measure (ACL2-COUNT X) is decreasing according to the relation
E0-ORD-< (which is known to be well-founded on the domain recognized
by E0-ORDINALP).  Note, however, that the unmeasured variable S is
being instantiated.  When applied to the goal at hand the above induction
scheme produces the following seven nontautological subgoals.

Subgoal *1/7
(IMPLIES (AND (NOT (ATOM X))
              (NOT (EQUAL (LEN X) 2))
              (NOT (EQ (CADR X) '+))
              (NOT (EQ (CADR X) '*)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/7'
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (NOT (EQUAL (CADR X) '+))
              (NOT (EQUAL (CADR X) '*)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

But simplification reduces this to T, using the :definitions COMPILE-
EXPRESSION, EVALUATE, EXECUTE, LEN, M and PUSH-STACK, the :executable-
counterparts of CAR, CDR, CONSP and EQUAL and primitive type reasoning.

Subgoal *1/6
(IMPLIES (AND (NOT (ATOM X))
              (NOT (EQUAL (LEN X) 2))
              (NOT (EQ (CADR X) '+))
              (EQ (CADR X) '*)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (PUSH-STACK (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (PUSH-STACK (EVALUATE (CAR X) A) S))
                     (PUSH-STACK (EVALUATE (CADDR X) A)
                                 (PUSH-STACK (EVALUATE (CAR X) A) S))))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/6'
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (NOT (EQUAL (CADR X) '+))
              (EQUAL (CADR X) '*)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

This simplifies, using the :definitions COMPILE-EXPRESSION, EVALUATE,
LEN and SYNTAXP, the :executable-counterparts of BINARY-+, BINARY-APPEND,
CAR, COMPILE-EXPRESSION, CONSP, EQ, EQUAL, IF and SYMBOLP, primitive
type reasoning and the :rewrite rule FOLD-CONSTS-IN-+, to the following
four conjectures.

Subgoal *1/6.4
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2)))
         (EQUAL (M (APPEND (COMPILE-EXPRESSION (CAR X))
                           (COMPILE-EXPRESSION (CADDR X))
                           '((MUL)))
                   A S)
                (CONS (* (EVALUATE (CAR X) A)
                         (EVALUATE (CADDR X) A))
                      S))).

But simplification reduces this to T, using the :definitions EXECUTE,
M, POP-STACK, PUSH-STACK, SYNTAXP and TOP-STACK, the :executable-counterparts
of BINARY-+, CAR, CDR, CONSP, EQ, EQUAL and IF, primitive type reasoning
and the :rewrite rules CAR-CONS, CDR-CONS, FOLD-CONSTS-IN-+ and SEQUENTIAL-
EXECUTION.

Subgoal *1/6.3
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*)
              (EQUAL (M '((LOAD INC)) A S)
                     (CONS (EVALUATE 'INC A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE 'INC A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE 'INC A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (EQUAL (CAR X) 'INC))
         (EQUAL (M '((LOAD *) (PUSH 1) (ADD)) A S)
                (CONS (+ 1 (LOOKUP '* A)) S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/6.2
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (NOT (EQUAL (CAR X) 'INC))
              (NOT (EQUAL (CAR X) 'SQ)))
         (EQUAL (M '((PUSH 0)) A S) (CONS 0 S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/6.1
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '*)
              (EQUAL (M '((LOAD SQ)) A S)
                     (CONS (EVALUATE 'SQ A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE 'SQ A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE 'SQ A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (EQUAL (CAR X) 'SQ))
         (EQUAL (M '((LOAD *) (DUP) (MUL)) A S)
                (CONS (* (LOOKUP '* A) (LOOKUP '* A))
                      S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/5
(IMPLIES (AND (NOT (ATOM X))
              (NOT (EQUAL (LEN X) 2))
              (EQ (CADR X) '+)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (PUSH-STACK (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (PUSH-STACK (EVALUATE (CAR X) A) S))
                     (PUSH-STACK (EVALUATE (CADDR X) A)
                                 (PUSH-STACK (EVALUATE (CAR X) A) S))))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/5'
(IMPLIES (AND (CONSP X)
              (NOT (EQUAL (LEN X) 2))
              (EQUAL (CADR X) '+)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

This simplifies, using the :definitions COMPILE-EXPRESSION, EVALUATE,
LEN and SYNTAXP, the :executable-counterparts of BINARY-+, BINARY-APPEND,
CAR, COMPILE-EXPRESSION, CONSP, EQ, EQUAL, IF and SYMBOLP, primitive
type reasoning and the :rewrite rule FOLD-CONSTS-IN-+, to the following
four conjectures.

Subgoal *1/5.4
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S))
              (NOT (EQUAL (+ 2 (LEN (CDDR X))) 2)))
         (EQUAL (M (APPEND (COMPILE-EXPRESSION (CAR X))
                           (COMPILE-EXPRESSION (CADDR X))
                           '((ADD)))
                   A S)
                (CONS (+ (EVALUATE (CAR X) A)
                         (EVALUATE (CADDR X) A))
                      S))).

But simplification reduces this to T, using the :definitions EXECUTE,
M, POP-STACK, PUSH-STACK, SYNTAXP and TOP-STACK, the :executable-counterparts
of BINARY-+, CAR, CDR, CONSP, EQ, EQUAL and IF, primitive type reasoning
and the :rewrite rules CAR-CONS, CDR-CONS, FOLD-CONSTS-IN-+ and SEQUENTIAL-
EXECUTION.

Subgoal *1/5.3
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+)
              (EQUAL (M '((LOAD INC)) A S)
                     (CONS (EVALUATE 'INC A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE 'INC A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE 'INC A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (EQUAL (CAR X) 'INC))
         (EQUAL (M '((LOAD +) (PUSH 1) (ADD)) A S)
                (CONS (+ 1 (LOOKUP '+ A)) S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/5.2
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+)
              (EQUAL (M (COMPILE-EXPRESSION (CAR X)) A S)
                     (CONS (EVALUATE (CAR X) A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE (CAR X) A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE (CAR X) A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (NOT (EQUAL (CAR X) 'INC))
              (NOT (EQUAL (CAR X) 'SQ)))
         (EQUAL (M '((PUSH 0)) A S) (CONS 0 S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/5.1
(IMPLIES (AND (CONSP X)
              (CONSP (CDR X))
              (NOT (EQUAL (+ 1 1 (LEN (CDDR X))) 2))
              (EQUAL (CADR X) '+)
              (EQUAL (M '((LOAD SQ)) A S)
                     (CONS (EVALUATE 'SQ A) S))
              (EQUAL (M (COMPILE-EXPRESSION (CADDR X))
                        A (CONS (EVALUATE 'SQ A) S))
                     (LIST* (EVALUATE (CADDR X) A)
                            (EVALUATE 'SQ A)
                            S))
              (EQUAL (+ 2 (LEN (CDDR X))) 2)
              (EQUAL (CAR X) 'SQ))
         (EQUAL (M '((LOAD +) (DUP) (MUL)) A S)
                (CONS (* (LOOKUP '+ A) (LOOKUP '+ A))
                      S))).

But simplification reduces this to T, using linear arithmetic, primitive
type reasoning and the :type-prescription rule LEN.

Subgoal *1/4
(IMPLIES (AND (NOT (ATOM X))
              (EQUAL (LEN X) 2)
              (NOT (EQ (CAR X) 'INC))
              (NOT (EQ (CAR X) 'SQ)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/4'
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (NOT (EQUAL (CAR X) 'INC))
              (NOT (EQUAL (CAR X) 'SQ)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

But simplification reduces this to T, using the :definitions COMPILE-
EXPRESSION, EVALUATE, EXECUTE, M and PUSH-STACK, the :executable-counterparts
of CAR, CDR, CONSP and EQUAL and primitive type reasoning.

Subgoal *1/3
(IMPLIES (AND (NOT (ATOM X))
              (EQUAL (LEN X) 2)
              (NOT (EQ (CAR X) 'INC))
              (EQ (CAR X) 'SQ)
              (EQUAL (M (COMPILE-EXPRESSION (CADR X)) A S)
                     (PUSH-STACK (EVALUATE (CADR X) A) S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/3'
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (NOT (EQUAL (CAR X) 'INC))
              (EQUAL (CAR X) 'SQ)
              (EQUAL (M (COMPILE-EXPRESSION (CADR X)) A S)
                     (CONS (EVALUATE (CADR X) A) S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

But simplification reduces this to T, using the :definitions COMPILE-
EXPRESSION, EVALUATE, EXECUTE, LEN, M, POP-STACK, PUSH-STACK and TOP-
STACK, the :executable-counterparts of CAR, CDR, CONSP and EQUAL, primitive
type reasoning and the :rewrite rules CAR-CONS, CDR-CONS and SEQUENTIAL-
EXECUTION.

Subgoal *1/2
(IMPLIES (AND (NOT (ATOM X))
              (EQUAL (LEN X) 2)
              (EQ (CAR X) 'INC)
              (EQUAL (M (COMPILE-EXPRESSION (CADR X)) A S)
                     (PUSH-STACK (EVALUATE (CADR X) A) S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM, EQ and PUSH-STACK we reduce the conjecture
to

Subgoal *1/2'
(IMPLIES (AND (CONSP X)
              (EQUAL (LEN X) 2)
              (EQUAL (CAR X) 'INC)
              (EQUAL (M (COMPILE-EXPRESSION (CADR X)) A S)
                     (CONS (EVALUATE (CADR X) A) S)))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

But simplification reduces this to T, using the :definitions COMPILE-
EXPRESSION, EVALUATE, EXECUTE, LEN, M, POP-STACK, PUSH-STACK and TOP-
STACK, the :executable-counterparts of CAR, CDR, CONSP and EQUAL, primitive
type reasoning and the :rewrite rules CAR-CONS, CDR-CONS, COMMUTATIVITY-
OF-+ and SEQUENTIAL-EXECUTION.

Subgoal *1/1
(IMPLIES (ATOM X)
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (PUSH-STACK (EVALUATE X A) S))).

By the simple :definitions ATOM and PUSH-STACK we reduce the conjecture
to

Subgoal *1/1'
(IMPLIES (NOT (CONSP X))
         (EQUAL (M (COMPILE-EXPRESSION X) A S)
                (CONS (EVALUATE X A) S))).

This simplifies, using the :definitions COMPILE-EXPRESSION and EVALUATE,
to the following two conjectures.

Subgoal *1/1.2
(IMPLIES (AND (NOT (CONSP X)) (SYMBOLP X))
         (EQUAL (M (LIST (LIST 'LOAD X)) A S)
                (CONS (LOOKUP X A) S))).

But simplification reduces this to T, using the :definitions EXECUTE,
M and PUSH-STACK, the :executable-counterparts of CONSP and EQUAL,
primitive type reasoning and the :rewrite rules CAR-CONS and CDR-CONS.

Subgoal *1/1.1
(IMPLIES (AND (NOT (CONSP X)) (NOT (SYMBOLP X)))
         (EQUAL (M (LIST (LIST 'PUSH X)) A S)
                (CONS X S))).

But simplification reduces this to T, using the :definitions EXECUTE,
M and PUSH-STACK, the :executable-counterparts of CONSP and EQUAL,
primitive type reasoning and the :rewrite rules CAR-CONS and CDR-CONS.

That completes the proof of *1.

Q.E.D.

Summary
Form:  ( DEFTHM KEY-COMPILER-LEMMA ...)
Rules: ((:DEFINITION ATOM)
        (:DEFINITION COMPILE-EXPRESSION)
        (:DEFINITION EQ)
        (:DEFINITION EVALUATE)
        (:DEFINITION EXECUTE)
        (:DEFINITION LEN)
        (:DEFINITION M)
        (:DEFINITION NOT)
        (:DEFINITION POP-STACK)
        (:DEFINITION PUSH-STACK)
        (:DEFINITION SYNTAXP)
        (:DEFINITION TOP-STACK)
        (:EXECUTABLE-COUNTERPART BINARY-+)
        (:EXECUTABLE-COUNTERPART BINARY-APPEND)
        (:EXECUTABLE-COUNTERPART CAR)
        (:EXECUTABLE-COUNTERPART CDR)
        (:EXECUTABLE-COUNTERPART COMPILE-EXPRESSION)
        (:EXECUTABLE-COUNTERPART CONSP)
        (:EXECUTABLE-COUNTERPART EQ)
        (:EXECUTABLE-COUNTERPART EQUAL)
        (:EXECUTABLE-COUNTERPART IF)
        (:EXECUTABLE-COUNTERPART SYMBOLP)
        (:FAKE-RUNE-FOR-LINEAR NIL)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE CDR-CONS)
        (:REWRITE COMMUTATIVITY-OF-+)
        (:REWRITE FOLD-CONSTS-IN-+)
        (:REWRITE SEQUENTIAL-EXECUTION)
        (:TYPE-PRESCRIPTION LEN))
Warnings:  None
Time:  1.96 seconds (prove: 1.78, print: 0.16, other: 0.02)
 KEY-COMPILER-LEMMA
ACL2 !>

[top] [prev] [next]


[top] [prev] [next]

ACL2 !>(defthm main-compiler-thm
        (equal (top-stack (m (compile-expression x) a s))
               (evaluate x a))
        :rule-classes nil)

Given what we've proved, this is trivial.


[top] [prev] [next]

ACL2 !>(defthm main-compiler-thm
        (equal (top-stack (m (compile-expression x) a s))
               (evaluate x a))
        :rule-classes nil)

By the simple :definition PUSH-STACK and the simple :rewrite rule KEY-
COMPILER-LEMMA we reduce the conjecture to

Goal'
(EQUAL (TOP-STACK (CONS (EVALUATE X A) S))
       (EVALUATE X A)).

But simplification reduces this to T, using the :definition TOP-STACK,
primitive type reasoning and the :rewrite rule CAR-CONS.

Q.E.D.

Summary
Form:  ( DEFTHM MAIN-COMPILER-THM ...)
Rules: ((:DEFINITION PUSH-STACK)
        (:DEFINITION TOP-STACK)
        (:FAKE-RUNE-FOR-TYPE-SET NIL)
        (:REWRITE CAR-CONS)
        (:REWRITE KEY-COMPILER-LEMMA))
Warnings:  None
Time:  0.05 seconds (prove: 0.02, print: 0.00, other: 0.03)
 MAIN-COMPILER-THM
ACL2 !>


[top] [prev] [next]

The Toy Java Virtual Machine and Byte Code Proofs

Finally, we will just illustrate some theorems we can prove about a more realistic machine model. Unlike the rest of the demo, here we show you theorems that have been proved (and that were included into the data base before the demo began) rather than ``live'' proofs. The plan is as follows.

We switch to the TJVM package in which we've defined a ``toy'' version of the Java Virtual Machine.
We show the definition of tjvm, a machine like m above, but which uses a much more elaborate state containing a method activation stack of frames, a heap, and a class table.
We exhibit the definition of three methods, "cons", "insert", and "isort". Do not confuse these byte coded methods with the Lisp functions of the same names! You can think of these methods as being the result of compiling Java methods that roughly correspond to the Lisp functions.
We configure a heap to contain a list represented by a linked collection of TJVM instance objects.
We run the "isort" method on that heap and show that the resulting heap address references a sorted version of the input.
Finally, we show a theorem that establishes that the "isort" method is a correct implementation of a sort program.


[top] [prev] [next]

ACL2 !>(in-package "TJVM")


[top] [prev] [next]

ACL2 !>(in-package "TJVM")
 "TJVM"
TJVM !>

Note that after switching packages the ACL2 prompt changes. Now when we type symbols they are read in the TJVM package instead of the ACL2 package. Some of the symbols we wished to define in our TJVM model were already defined in ACL2. This keeps those two name spaces as disjoint as want.


[top] [prev] [next]

TJVM !>(pe 'step)

Recall that pe prints the named function.

Step is the name of the state transition function for the TJVM machine.


[top] [prev] [next]

TJVM !>(pe 'step)
   d      2  (INCLUDE-BOOK "isort")
             \
>L d          (DEFUN STEP (S)
                     (DO-INST (NEXT-INST S) S))
TJVM !>

Step is defined in the "isort" book.

It is defined to use next-inst to fetch the next instruction from the state and then to use do-inst to determine the next state. We will next look at those two functions.


[top] [prev] [next]

TJVM !>(pe 'next-inst)

The next instruction is obtained by next-inst.


[top] [prev] [next]

TJVM !>(pe 'next-inst)
   d      2  (INCLUDE-BOOK "isort")
             \
>L            (DEFUN NEXT-INST (S)
                     (NTH (PC (TOP-FRAME S))
                          (PROGRAM (TOP-FRAME S))))
TJVM !>

Next-inst fetches the nth element of a certain program, where n is the program counter (pc) in the top-most frame of the method activation stack of the state. The program is also found in that frame and is the byte-coded method body of the currently active method. You'll see a method body soon. In fact, we'll show you an entire state soon.


[top] [prev] [next]

TJVM !>(pe 'do-inst)

A given instruction is executed by do-inst.


[top] [prev] [next]

TJVM !>(pe 'do-inst)
   d      2  (INCLUDE-BOOK "isort")
             \
>L            (DEFUN DO-INST (INST S)
                (CASE (OP-CODE INST)
                 (PUSH          (EXECUTE-PUSH INST S))
                 (POP           (EXECUTE-POP INST S))
                 (LOAD          (EXECUTE-LOAD INST S))
                 (STORE         (EXECUTE-STORE INST S))
                 (ADD           (EXECUTE-ADD INST S))
                 (SUB           (EXECUTE-SUB INST S))
                 (MUL           (EXECUTE-MUL INST S))
                 (GOTO          (EXECUTE-GOTO INST S))
                 (IFEQ          (EXECUTE-IFEQ INST S))
                 (IFGT          (EXECUTE-IFGT INST S))
                 (IFLE          (EXECUTE-IFLE INST S))
                 (INVOKEVIRTUAL (EXECUTE-INVOKEVIRTUAL INST S))
                 (INVOKESTATIC  (EXECUTE-INVOKESTATIC INST S))
                 (RETURN        (EXECUTE-RETURN INST S))
                 (XRETURN       (EXECUTE-XRETURN INST S))
                 (NEW           (EXECUTE-NEW INST S))
                 (GETFIELD      (EXECUTE-GETFIELD INST S))
                 (PUTFIELD      (EXECUTE-PUTFIELD INST S))
                 (INSTANCEOF    (EXECUTE-INSTANCEOF INST S))
                 (HALT          S)
                 (OTHERWISE     S)))
TJVM !>

This function enumerates the possible byte codes and gives the next state produced by each, by calling an appropriate ``execute'' function.

[top] [prev] [next]


[top] [prev] [next]

TJVM !>(pe 'execute-load)

The semantics of each byte code, op, is given by a function named execute-op. We can print out the semantics of selected instructions. Here is load. Then we'll look at invokevirtual.


[top] [prev] [next]

TJVM !>(pe 'execute-load)
   d      2  (INCLUDE-BOOK "isort")
             \
>L            (DEFUN
                EXECUTE-LOAD (INST S)
                (MAKE-STATE
                     (PUSH (MAKE-FRAME (+ 1 (PC (TOP-FRAME S)))
                                       (LOCALS (TOP-FRAME S))
                                       (PUSH (BINDING (ARG1 INST)
                                                      (LOCALS (TOP-FRAME S)))
                                             (STACK (TOP-FRAME S)))
                                       (PROGRAM (TOP-FRAME S)))
                           (POP (CALL-STACK S)))
                     (HEAP S)
                     (CLASS-TABLE S)))
TJVM !>

States are triples consisting of an ``activation stack,'' a ``heap,'' and a ``class table.'' Each frame of the activation stack contains a program counter, a local variable binding environment, an operand stack for intermediate results, and the byte code program of the currently active method. The heap associates with addresses or ``references'' certain ``instance objects.'' The latter are objects that represent class instances by listing the fields of each class in the superclass hierarchy of the object and the contents of each field. Finally, the class table associates with class names the descriptions of the corresponding classes. The descriptions specify fields and methods.

To execute a load we increment the program counter of the active method and push onto the operand stack the binding of the variable named in the instruction.


[top] [prev] [next]

TJVM !>(pe 'execute-invokevirtual)

Here is the much more elaborate byte code for invoking a virtual method. The key problem here is to resolve the method to be invoked. Method resolution is based on the method name in the instruction and the ``self'' object (referred to as this in the method body). The self object is a reference into the heap and is buried at a certain depth in the operand stack at the time of method invocation. The depth is a function of the number of a parameters to the method.


[top] [prev] [next]

TJVM !>(pe 'execute-invokevirtual)
   d      2  (INCLUDE-BOOK "isort")
             \
>L            (DEFUN
               EXECUTE-INVOKEVIRTUAL (INST S)
               (LET*
                ((METHOD-NAME (ARG2 INST))
                 (NFORMALS (ARG3 INST))
                 (OBJ-REF (TOP (POPN NFORMALS (STACK (TOP-FRAME S)))))
                 (OBJ-CLASS-NAME (CLASS-NAME-OF-REF OBJ-REF (HEAP S)))
                 (CLOSEST-METHOD
                      (LOOKUP-METHOD METHOD-NAME
                                     OBJ-CLASS-NAME (CLASS-TABLE S)))
                 (VARS (CONS 'THIS
                             (METHOD-FORMALS CLOSEST-METHOD)))
                 (PROG (METHOD-PROGRAM CLOSEST-METHOD)))
                (MAKE-STATE
                 (PUSH
                   (MAKE-FRAME 0
                               (REVERSE (BIND-FORMALS (REVERSE VARS)
                                                      (STACK (TOP-FRAME S))))
                               NIL PROG)
                   (PUSH (MAKE-FRAME (+ 1 (PC (TOP-FRAME S)))
                                     (LOCALS (TOP-FRAME S))
                                     (POPN (LEN VARS) (STACK (TOP-FRAME S)))
                                     (PROGRAM (TOP-FRAME S)))
                         (POP (CALL-STACK S))))
                 (HEAP S)
                 (CLASS-TABLE S))))
TJVM !>

For the purposes of this demo it is not important that you understand this function. What you should get out of it is that it is possible to describe complicated programming languages in ACL2.

[top] [prev] [next]


[top] [prev] [next]

TJVM !>(pe 'tjvm)

This is our toy model of the Java Virtual Machine.


[top] [prev] [next]

TJVM !>(pe 'tjvm)
   d      2  (INCLUDE-BOOK "isort")
             \
>L d          (DEFUN TJVM (S N)
                (IF (ZP N)
                    S
                    (TJVM (STEP S) (- N 1))))
TJVM !>

This function uses step to execute a given number of instructions.

We can use ACL2's encapsulation mechanism to formalize a machine that executes until a halted state is encountered. But we do not do that in this demo.

The formulation shown above can be used to study computations that do not terminate. For example, for some method we might prove that no N is sufficient to put the machine in a halted state, or we can use the function to pick out a particular intermediate state in a trace of infinite length. We can also prove theorems that characterize exactly how many TJVM instructions must be taken to reach a certain state or ``how long'' a method runs. Thus, we tend to prefer this style of semantics. We sometimes refer to N as the ``clock'' and think of it ``ticking down.''


[top] [prev] [next]

TJVM !>(cons-class)

Ok, get ready for a big object. This function of no arguments evaluates to a class description. Such a class description is one element in the machine's class table.

The class you are about to see implements cons and includes two other methods for doing insertion sort. We could have separated out the sorting methods into another class built as an extension of the "Cons" class. Class inheritance is handled by our model. But to keep the demo simple we just put all the methods we needed into one class.


[top] [prev] [next]

TJVM !>(cons-class)
("Cons" ("Object")            ; superclass chain
        ("car" "cdr")         ; fields
                              ; methods
        (("cons" (X Y)        ;  method name and parameters
           (NEW "Cons")       ;  byte-coded method body 
           (STORE TEMP)
           (LOAD TEMP)
           (LOAD X)
           (PUTFIELD "Cons" "car")
           (LOAD TEMP)
           (LOAD Y)
           (PUTFIELD "Cons" "cdr")
           (LOAD TEMP)
           (XRETURN))
         ("insert" (E X)
           (LOAD X)
           (IFEQ 18)
           (LOAD X)
           (GETFIELD "Cons" "car")
           (LOAD E)
           (SUB)
           (IFLE 5)
           (LOAD E)
           (LOAD X)
           (INVOKESTATIC "Cons" "cons" 2)
           (XRETURN)
           (LOAD X)
           (GETFIELD "Cons" "car")
           (LOAD E)
           (LOAD X)
           (GETFIELD "Cons" "cdr")
           (INVOKESTATIC "Cons" "insert" 2)
           (INVOKESTATIC "Cons" "cons" 2)
           (XRETURN)
           (LOAD E)
           (LOAD X)
           (INVOKESTATIC "Cons" "cons" 2)
           (XRETURN))
         ("isort" (X)
          (LOAD X)
          (IFEQ 8)
          (LOAD X)
          (GETFIELD "Cons" "car")
          (LOAD X)
          (GETFIELD "Cons" "cdr")
          (INVOKESTATIC "Cons" "isort" 1)
          (INVOKESTATIC "Cons" "insert" 2)
          (XRETURN)
          (LOAD X)
          (XRETURN))))
TJVM !>

This is a class description. The class is called "Cons".

The superclass chain from here goes directly to the generic "Object" class.

Objects in this class have two fields, called "car" and "cdr". We do not formalize types in this toy machine.

The class has three methods, named "cons", "insert", and "isort". We do not formalize method attributes, such as access privileges in this toy machine.

You might read the byte code for the methods. It should basically make sense if you can guess the semantics of the byte coded instructions. Just imagine compiling the Lisp functions insert and isort, seen earlier, for a stack machine. But there is no point really in trying to understand this in the demo. Just understand that here is realistic assembly code that purports to do sorting of linked lists.

[top] [prev] [next]


[top] [prev] [next]

TJVM !>(defconst *s0*
         (make-state
          (push                                         ; activation stack
           (make-frame 1                                ;  pc
                       '((x . (REF 4)))                 ;  local vars
                       '((REF 4))                       ;  stack
                       '((load x)                       ;  byte code
                         (invokestatic "Cons" "isort" 1);   for most
                         (halt)))                       ;   recent method
           nil)
          '((0 ("Cons" ("car" . 5) ("cdr" . 0))         ; heap
               ("Object"))
            (1 ("Cons" ("car" . 1) ("cdr" REF 0))
               ("Object"))
            (2 ("Cons" ("car" . 4) ("cdr" REF 1))
               ("Object"))
            (3 ("Cons" ("car" . 2) ("cdr" REF 2))
               ("Object"))
            (4 ("Cons" ("car" . 3) ("cdr" REF 3))
               ("Object")))
          (list (cons-class)                            ; class table
                (object-class))))

Here is state poised to execute a call of the "isort" method on the object at heap address 4.


[top] [prev] [next]

TJVM !>(defconst *s0*
         (make-state
          (push                                         ; activation stack
           (make-frame 1                                ;  pc
                       '((x . (REF 4)))                 ;  local vars
                       '((REF 4))                       ;  stack
                       '((load x)                       ;  byte code
                         (invokestatic "Cons" "isort" 1);   for most
                         (halt)))                       ;   recent method
           nil)
          '((0 ("Cons" ("car" . 5) ("cdr" . 0))         ; heap
               ("Object"))
            (1 ("Cons" ("car" . 1) ("cdr" REF 0))
               ("Object"))
            (2 ("Cons" ("car" . 4) ("cdr" REF 1))
               ("Object"))
            (3 ("Cons" ("car" . 2) ("cdr" REF 2))
               ("Object"))
            (4 ("Cons" ("car" . 3) ("cdr" REF 3))
               ("Object")))
          (list (cons-class)                            ; class table
                (object-class))))

Summary
Form:  ( DEFCONST *S0* ...)
Rules: NIL
Warnings:  None
Time:  0.00 seconds (prove: 0.00, print: 0.00, other: 0.00)
 *S0*
TJVM !>

[top] [prev] [next]


[top] [prev] [next]

TJVM !>(deref* (top (stack (top-frame *s0*))) (heap *s0*))

Dereferencing the address on top of the operand stack (heap address 4) in the heap above gives us the abstract meaning of that object.


[top] [prev] [next]

TJVM !>(deref* (top (stack (top-frame *s0*))) (heap *s0*))
(3 2 4 1 5)
TJVM !>

Heap address 4 refers to a linked list representing (3 2 4 1 5). That is the list we will attempt to sort.


[top] [prev] [next]

TJVM !>(defconst *s1* (tjvm *s0* 250))

Now we step the state 250 times.


[top] [prev] [next]

TJVM !>(defconst *s1* (tjvm *s0* 250))

Summary
Form:  ( DEFCONST *S1* ...)
Rules: NIL
Warnings:  None
Time:  1.31 seconds (prove: 0.00, print: 0.00, other: 1.31)
 *S1*
TJVM !>


[top] [prev] [next]

TJVM !>(deref* (top (stack (top-frame *s1*))) (heap *s1*))

And dereference the item on top of the final operand stack, in the final heap.


[top] [prev] [next]

TJVM !>(deref* (top (stack (top-frame *s1*))) (heap *s1*))
(1 2 3 4 5)
TJVM !>

And lo! It is the sorted version of the input list!


[top] [prev] [next]

TJVM !>(pe 'isort-spec)

Here is a theorem that shows that this was not a fluke.


[top] [prev] [next]

TJVM !>(pe 'isort-spec)
   d      2  (INCLUDE-BOOK "isort")
             \
>             (DEFTHM ISORT-SPEC
                (IMPLIES (AND (STANDARD-HYPS S0)
                              (EQUAL (NEXT-INST S0)
                                     '(INVOKESTATIC "Cons" "isort" 1)))
                         (LET* ((X0 (TOP (STACK (TOP-FRAME S0))))
                                (HEAP0 (HEAP S0))
                                (N0 (ISORT-CLOCK X0 HEAP0))
                                (S1 (TJVM S0 N0))
                                (X1 (TOP (STACK (TOP-FRAME S1))))
                                (HEAP1 (HEAP S1)))
                            (IMPLIES (OK-REFP X0 HEAP0)
                                     (LET ((LIST0 (DEREF* X0 HEAP0))
                                           (LIST1 (DEREF* X1 HEAP1)))
                                       (AND (ORDERED LIST1)
                                            (PERM LIST1 LIST0)))))))
TJVM !>

The theorem says that if you have state poised to execute "isort" on a good heap address and you step that state a certain number of times given here constructively by (isort-clock x0 heap0), you obtain a state in which the top of the stack contains a heap address that dereferences to an ordered permutation of the input.


[top] [prev] [next]

TJVM !>(pe 'tjvm-isort-lemma)

The above theorem was proved in two steps. The first, and hardest, was to show that the execution of the byte code ``does the same thing'' as our previously verified isort function in Lisp. That theorem is shown here. The second step was the previously proved correctness of isort.


[top] [prev] [next]

TJVM !>(pe 'tjvm-isort-lemma)
   d      2  (INCLUDE-BOOK "isort")
             \
>             (DEFTHM TJVM-ISORT-LEMMA
                (IMPLIES (AND (STANDARD-HYPS S0)
                              (EQUAL (NEXT-INST S0)
                                     '(INVOKESTATIC "Cons" "isort" 1)))
                         (LET* ((X0 (TOP (STACK (TOP-FRAME S0))))
                                (HEAP0 (HEAP S0))
                                (N0 (ISORT-CLOCK X0 HEAP0))
                                (S1 (TJVM S0 N0))
                                (X1 (TOP (STACK (TOP-FRAME S1))))
                                (HEAP1 (HEAP S1)))
                           (IMPLIES (OK-REFP X0 HEAP0)
                                    (EQUAL (DEREF* X1 HEAP1)
                                           (ISORT (DEREF* X0 HEAP0)))))))
TJVM !>


[top] [prev] [next]

TJVM !>(quote "The End")


[top] [prev]

TJVM !>(quote "The End")
"The End"
TJVM !>

That completes the demo.

All of the simple examples here -- algorithms, computer arithmetic, netlist description languages, compilers, microprocessor descriptions, code proofs -- have much more elaborate counterparts in ongoing research projects being carried on in the ACL2 community. See Computer-Aided Reasoning: ACL2 Case Studies for detailed examples, including full scripts of industrial projects.
If you want to learn to use ACL2, we recommend that you read Computer-Aided Reasoning: An Approach.
If you want to obtain ACL2 or browse the online documentation or download many papers describing it, see the ACL2 Home Page.

Thanks for your time.

Matt Kaufmann and J Moore
June, 2000