From tfm%computer-lab.cambridge.ac.uk Sun, 4 Jun 89
Date: Sun, 4 Jun 89 22:32:18 BST
From: Tom Melham <tfm%computer-lab.cambridge.ac.uk>
To: info-hol%clover.ucdavis.edu
Subject: Steve Crocker's theorem... in HOL.
Status: RO

RE: Steve Crocker's suggestion for bit vectors
==============================================

For the type (bool)list (which already exists in HOL88) the theorem that
Steve mentioned in his message works out as follows:

   Suppose that the binary operation op:*->*->* is associative
   and that z:* is an identity for this operation.  Then for any
   values a0:* and a1:* there exists a function f:(bool)list->*
   such that:

      a) f []   = z
      b) f [F] = a0
      c) f [T] = a1
      d) f (APPEND l1 l2) = op (f l1) (f l2)

   Furthermore, there is only one function with these properties.

This is essentially the restriction of the theorem to monoids, which Steve
mentioned in his last message.  At the end of this message, Steve asks the
question:



+---------------------------------------------------
| Is it possible to set
| this up as one theorem that applies to all semigroups, and in
| addition, if the semigroup is also a monoid, then the value of f when
| applied to zero length bitstrings is automatically determined?
+----------------------------------------------------------

The above theorem (I think) answers this question with "partly". If we
know that (*, op, z) is a monoid, then we know of course that it has the
identity element  z.  The value of f when applied to the zero-length
bit string is, as it were, "automatically determined" by the theorem shown
above.  It is determined that f [] shall be z. Of course, to apply the
theorem, we have to show that z is in fact an indentity for op.
But once this is done, the only things left to be determined by
the "user" are a0 and a1.   I'm not sure, however, about the first part of
Steve's question.  Does the above theorem "apply" to all semigroups.  I
don't think so....

Of course, if you drop the uniqueness part, you don't need to supply a value
for the empty list.

It turns out to be very easy to prove the theorem shown above in HOL88
from the built-in theory of lists.  The actual HOL theorem is:

   |- !e:*. !op:*->*->*.
       ((!x. op e x = x) /\ (!x. op x e = x) /\
        (!x y z. op x (op y z) = op (op x y) z))
           ==>
      !x1:*. !x2. ?!fn:(bool)list -> *.
      (fn [] = e) /\
      (fn [T] = x1) /\
      (fn [F] = x2) /\
      (!l2 l1. fn (APPEND l1 l2) = op (fn l1) (fn l2))")

A HOL88 proof of this theorem is given below.  I'm sorry that the proof itself
is really quite barbarous --- I only spent a half hour or so on it, and it's
the first proof that came to mind.  Some illustrations of the use of the
theorem in defining the length of a bit vector, etc, are also given below.

As I mentioned previously, I'm aiming to support this sort of thing in my new
types package.  Meanwhile, I find the stuff below (which is based on Steve's
idea) to be so elegant that I promise to develop it and include it in the
distributed bit-vector theory.

Tom



% ===================================================================== %
% DESCRIPTION: Hol88 proof of the "monoid" theorem for bit-vectors.     %
%                                                                       %
% DATE: June 3 1989                                                     %
% AUTHOR: T.F. Melham                                                   %
% ===================================================================== %

% --------------------------------------------------------------------- %
% First some ad-hoc lemmas.                                             %
% --------------------------------------------------------------------- %


let lemma1 =
    let th1 = INST_TYPE [":bool",":*";":*",":**"] list_Axiom in
    let th2 = SPECL ["e:*"; "\r h (t:(bool)list).
                             (op (h=>(x1:*) | x2) (r:*)):*"] th1 in
    let th3 = BETA_RULE th2 in
    let th4 = CONV_RULE EXISTS_UNIQUE_CONV th3 in
              CONJUNCT1 th4;;

let lemma2 =
    TAC_PROOF(([], "!l1:(*)list. APPEND l1 [] = l1"),
             INDUCT_THEN list_INDUCT ASSUME_TAC THEN
             ASM_REWRITE_TAC [APPEND]);;

let lemma3 =
    TAC_PROOF(([], "!l1 l2 h. APPEND l1 (CONS h l2) =
                              APPEND (APPEND l1 [h:*]) l2"),
     INDUCT_THEN list_INDUCT ASSUME_TAC THENL
     [REWRITE_TAC [APPEND];
      PURE_ONCE_REWRITE_TAC [APPEND] THEN
      PURE_ONCE_ASM_REWRITE_TAC [] THEN
      REWRITE_TAC [APPEND;lemma2]]);;

let lemma4 = let th1 = CONJUNCT2 APPEND in
             let th2 = SPECL ["NIL:(*)list"] th1 in
             REWRITE_RULE [CONJUNCT1 APPEND] th2;;





% --------------------------------------------------------------------- %
% Now, prove the theorem.                                               %
% --------------------------------------------------------------------- %

let Theorem =
    TAC_PROOF(([], "!e:*. !op:*->*->*.
                ((!x. op e x = x) /\
                 (!x. op x e = x) /\
                 (!x y z. op x (op y z) = op (op x y) z))
                   ==>
                 !x1:*. !x2. ?!fn:(bool)list -> *.
                   (fn [] = e) /\
                   (fn [T] = x1) /\
                   (fn [F] = x2) /\
                   (!l2 l1. fn (APPEND l1 l2) = op (fn l1) (fn l2))"),
        REPEAT STRIP_TAC THEN
        CONV_TAC EXISTS_UNIQUE_CONV THEN CONJ_TAC THENL
        [STRIP_ASSUME_TAC lemma1 THEN
         EXISTS_TAC "fun:(bool)list->*" THEN
         ASM_REWRITE_TAC [] THEN
         INDUCT_THEN list_INDUCT ASSUME_TAC THENL
         [ASM_REWRITE_TAC [lemma2];
          PURE_ONCE_REWRITE_TAC [lemma3] THEN
          ASM_REWRITE_TAC [] THEN GEN_TAC THEN
          INDUCT_THEN list_INDUCT ASSUME_TAC THENL
          [ASM_REWRITE_TAC [APPEND];
           PURE_ONCE_REWRITE_TAC [APPEND] THEN
           ASM_REWRITE_TAC [] THEN
           PURE_ONCE_REWRITE_TAC
             [SYM(SPEC_ALL
              (ASSUME  "!x:*. !y z. op x(op y z) = op(op x y)z"))] THEN
           POP_ASSUM (\th. PURE_ONCE_REWRITE_TAC [th] THEN ASSUME_TAC th) THEN
           ASM_REWRITE_TAC []]];
         CONV_TAC (REDEPTH_CONV BETA_CONV) THEN
         REPEAT STRIP_TAC THEN
         CONV_TAC FUN_EQ_CONV THEN
         INDUCT_THEN list_INDUCT ASSUME_TAC THENL
         [ASM_REWRITE_TAC [];
          PURE_ONCE_REWRITE_TAC [SYM(SPEC_ALL lemma4)] THEN
          ASM_REWRITE_TAC [] THEN
          GEN_TAC THEN BOOL_CASES_TAC "h:bool" THEN
          ASM_REWRITE_TAC []]]);;



% --------------------------------------------------------------------- %
% Now define Length using the theorem.                                  %
% --------------------------------------------------------------------- %

new_theory `temp`;;

let PLUS_lemma =
    let th1.(th2._) = CONJUNCTS ADD_CLAUSES in
    LIST_CONJ [GEN_ALL th1;GEN_ALL th2;ADD_ASSOC];;

let Length_EXISTS =
    let th1 = SPECL ["1";"1"] (MATCH_MP Theorem PLUS_lemma) in
    CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV th1);;


let Length =
    new_specification `Length` [`constant`,`Length`] Length_EXISTS;;

% --------------------------------------------------------------------- %
% Define Rev (reverse) using the theorem.                               %
% --------------------------------------------------------------------- %

let Rev_EXISTS =
    let th1 = INST_TYPE [":(bool)list", ":*"] Theorem in
    let th2 = SPECL ["[]:(bool)list";"\x:(bool)list. \y. APPEND y x"] th1 in
    let th3 = BETA_RULE th2 in
    let th4 = REWRITE_RULE [APPEND_ASSOC;APPEND;lemma2] th3 in
    let th5 = SPECL ["[T]";"[F]"] th4 in
    CONJUNCT1 (CONV_RULE EXISTS_UNIQUE_CONV th5);;

let Rev =
    new_specification `Rev` [`constant`,`Rev`] Rev_EXISTS;;

% --------------------------------------------------------------------- %
% End.                                                                  %
% --------------------------------------------------------------------- %




