File (* halvesScript.sml, author L. Morris, created 10/31--11/20/02.
Utility and induction theorems based on breaking lists in the
middle; corresponding provisions for type word. It is expected that
definition of functions by split-in-the middle recursion will be done
via Hol_defn, with termination proofs assisted by F/B_HALF_SHORTER,
etc.; former hand-built definition tools have been exiled to
FOLDCW_Theory, along with some theorems which may be of interest
relating FOLDC to different forms of FOLD and to monoids. *)
open HolKernel boolLib Parse;
(*
app load ["ante_allTacs","numLib","listTheory",
"rich_listTheory","tautLib","operatorTheory","wordLib","pred_setLib",
"wordSpecTheory","Defn","SingleStep"];
*)
infix 2 THENSGS THENFIN;
open ante_allTacs arithmeticTheory numLib numTheory
res_quanLib prim_recTheory listTheory tautLib pairTheory operatorTheory
combinTheory word_baseTheory word_bitopTheory wordSpecTheory SingleStep;
val _ = new_theory "halves";
(* First we introduce rounding-down (FLR_2) and rounding_up (CLG_2)
functions for halving a natural number, avoiding the detour into the
reals of the mathematically standard notations floor(n/2) etc. Use of the
definitions should be strongly shunned for the present application;
instead charcterizing theorems FLR_CLG_2_SUM and FLR_CLG_2_OR should
be used, avoiding the quagmire of reasoning about division. (In an
earlier, and only slightly more laborious, version of this theory, the
conjunction of these two theorems was used as a specification, and the
present definitions were theorems. *)
val FLR_2_DEF = new_definition ("FLR_2_DEF", Term`FLR_2 n = n DIV 2`);
val CLG_2_DEF = new_definition ("CLG_2_DEF", Term`CLG_2 n = n - n DIV 2`);
val FLR_CLG_2_SUM = store_thm ("FLR_CLG_2_SUM", Term
`!n. (FLR_2 n + CLG_2 n = n)`,
GEN_TAC THEN REWRITE_TAC [FLR_2_DEF, CLG_2_DEF]
THEN MP_TAC (SPEC (Term`n:num`)
(CONV_RULE REDUCE_CONV (SPEC (Term`2`) DIV_LESS_EQ)))
THEN ARITH_TAC);
val FLR_CLG_2_OR = store_thm ("FLR_CLG_2_OR", Term
`!n. ((FLR_2 n = CLG_2 n) \/ (FLR_2 n + 1 = CLG_2 n))`,
GEN_TAC THEN DISJ_CASES_TAC (SPEC_ALL EVEN_OR_ODD)
THEN REWRITE_TAC [FLR_2_DEF, CLG_2_DEF] THENL
[IMP_RES_TAC EVEN_EXISTS THEN DISJ1_TAC THEN AR
THEN CONV_TAC (ONCE_DEPTH_CONV (REWR_CONV MULT_SYM))
THEN CRE MULT_DIV THEN ARITH_TAC
,IMP_RES_TAC ODD_EXISTS THEN DISJ2_TAC THEN AR
THEN CONV_TAC (ONCE_DEPTH_CONV (REWR_CONV MULT_SYM))
THEN REWRITE_TAC [ADD1] THEN CRE DIV_MULT THEN ARITH_TAC]);
val CLG_FLR_2_SUM = save_thm ("CLG_FLR_2_SUM",
CONV_RULE (ONCE_DEPTH_CONV (REWR_CONV ADD_SYM)) FLR_CLG_2_SUM);
(* CLG_FLR_2_SUM = |- !n. CLG_2 n + FLR_2 n = n *)
val CLG_FLR_2_OR = save_thm ("CLG_FLR_2_OR",
CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) FLR_CLG_2_OR);
(* CLG_FLR_2_OR = !n. (CLG_2 n = FLR_2 n) \/ (CLG_2 n = FLR_2 n + 1) *)
val CLG_2_SUB = store_thm ("CLG_2_SUB", Term
`!n. CLG_2 n = n - FLR_2 n`,
GEN_TAC THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM) THEN ARITH_TAC);
val FLR_CLG_2_LE = store_thm ("FLR_CLG_2_LE", Term
`!n. FLR_2 n <= n /\ CLG_2 n <= n`,
GEN_TAC THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM) THEN ARITH_TAC);
val ZERO_LESS_FLR_CLG_2 = store_thm ("ZERO_LESS_FLR_CLG_2", Term
`!n. n > 1 ==> 0 < FLR_2 n /\ 0 < CLG_2 n`,
GEN_TAC THEN MP_TAC (SPEC_ALL FLR_CLG_2_OR)
THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM) THEN ARITH_TAC);
val [ZERO_LESS_FLR_2, ZERO_LESS_CLG_2] = map2 (curry save_thm)
["ZERO_LESS_FLR_2", "ZERO_LESS_CLG_2"] (GCONJ_LIST 2 ZERO_LESS_FLR_CLG_2);
(* ZERO_LESS_FLR_2 = |- !n. n > 1 ==> 0 < FLR_2 n
ZERO_LESS_CLG_2 = |- !n. n > 1 ==> 0 < CLG_2 n *)
val FLR_CLG_2_LESS = store_thm ("FLR_CLG_2_LESS", Term
`!n. n > 1 ==> FLR_2 n < n /\ CLG_2 n < n`,
GEN_TAC THEN STRIP_TAC THEN IMP_RES_THEN MP_TAC ZERO_LESS_FLR_CLG_2
THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM)
THEN ARITH_TAC);
val [FLR_2_LESS, CLG_2_LESS] = map2 (curry save_thm)
["FLR_2_LESS", "CLG_2_LESS"] (GCONJ_LIST 2 FLR_CLG_2_LESS);
(* FLR_2_LESS = |- !n. n > 1 ==> FLR_2 n < n
CLG_2_LESS = |- !n. n > 1 ==> CLG_2 n < n *)
(* Let us now introduce functions, F_HALF, B_HALF, (for "front" and "back"
half) to split a list as the APPEND of two nearly equal pieces. As with
FLR_2 and CLG_2, the definitions should be forgotten (as a disincentive
to using them, we do not open rich_listTheory, where FIRSTN, LASTN reside)
and instead the characterizing theorems F_B_HALVES_APP and F_B_HALVES_OR,
relating F_HALF and B_HALF to APPEND and LENGTH respectively, should be
used as if they were the definitions. To avert bias, we give, besides the
plain version where the back half gets the middle element if the original
list length was odd, an "ALT" version where the front half gets it. *)
val F_HALF_DEF = new_definition ("F_HALF_DEF", Term
`F_HALF (l:'a list) = FIRSTN (FLR_2 (LENGTH l)) l`);
val B_HALF_DEF = new_definition ("B_HALF_DEF", Term
`B_HALF (l:'a list) = LASTN (CLG_2 (LENGTH l)) l`);
val F_HALT_DEF = new_definition ("F_HALT_DEF", Term
`F_HALT (l:'a list) = FIRSTN (CLG_2 (LENGTH l)) l`);
val B_HALT_DEF = new_definition ("B_HALT_DEF", Term
`B_HALT (l:'a list) = LASTN (FLR_2 (LENGTH l)) l`);
val F_B_HALVES_APP = store_thm ("F_B_HALVES_APP", Term
`!l:'a list. (APPEND (F_HALF l) (B_HALF l) = l)`,
GEN_TAC THEN REWRITE_TAC [F_HALF_DEF, B_HALF_DEF]
THEN CR rich_listTheory.APPEND_FIRSTN_LASTN
THEN MATCH_ACCEPT_TAC CLG_FLR_2_SUM);
val F_B_HALTS_APP = store_thm ("F_B_HALTS_APP", Term
`!l:'a list. (APPEND (F_HALT l) (B_HALT l) = l)`,
GEN_TAC THEN REWRITE_TAC [F_HALT_DEF, B_HALT_DEF]
THEN CR rich_listTheory.APPEND_FIRSTN_LASTN
THEN MATCH_ACCEPT_TAC FLR_CLG_2_SUM);
(* We need to relate F/B_HALF/ALT directly via LENGTH to FLR/CLG_2 *)
val HALF_LENGTHS = store_thm ("HALF_LENGTHS", Term
`!l:'a list. (LENGTH (F_HALF l) = FLR_2 (LENGTH l)) /\
(LENGTH (B_HALF l) = CLG_2 (LENGTH l))`,
GEN_TAC THEN REWRITE_TAC [F_HALF_DEF, FLR_2_DEF, B_HALF_DEF, CLG_2_DEF]
THEN CREL [rich_listTheory.LENGTH_FIRSTN, rich_listTheory.LENGTH_LASTN]
THENL [MATCH_MP_TAC DIV_LESS_EQ, ALL_TAC]
THEN ARITH_TAC);
val [F_HALF_LENGTH, B_HALF_LENGTH] = map2 (curry save_thm)
["F_HALF_LENGTH", "B_HALF_LENGTH"] (GCONJ_LIST 2 HALF_LENGTHS);
(* F_HALF_LENGTH = |- !l. LENGTH (F_HALF l) = FLR_2 (LENGTH l)
B_HALF_LENGTH = |- !l. LENGTH (B_HALF l) = CLG_2 (LENGTH l) *)
(* following lemmas about lengths are for now in HALF-versions only *)
val LENGTH_EQ_HALVES_LEM = store_thm ("LENGTH_EQ_HALVES_LEM", Term
`!l:'a list m:'b list. (LENGTH (F_HALF l) = LENGTH (F_HALF m)) /\
(LENGTH (B_HALF l) = LENGTH (B_HALF m)) =
(LENGTH l = LENGTH m)`,
REPEAT GEN_TAC THEN REWRITE_TAC [HALF_LENGTHS] THEN EQ_TAC THENL
[STRIP_TAC THEN CONV_TAC (BINOP_CONV (REWR_CONV (GSYM FLR_CLG_2_SUM)))
THEN AR,
DISCH_TAC THEN AR]);
val F_B_HALVES_APPEND_EQ = store_thm ("F_B_HALVES_APPEND_EQ", Term
`!l m:'a list.
(LENGTH l = FLR_2 (LENGTH (APPEND l m))) /\
(LENGTH m = CLG_2 (LENGTH (APPEND l m))) ==>
(F_HALF (APPEND l m) = l) /\ (B_HALF (APPEND l m) = m)`,
REPEAT GEN_TAC THEN DISCH_THEN (STRIP_ASSUME_TAC o GSYM)
THEN ASM_REWRITE_TAC [F_HALF_DEF, B_HALF_DEF,
rich_listTheory.FIRSTN_LENGTH_APPEND,
rich_listTheory.LASTN_LENGTH_APPEND]);
val [F_HALF_APPEND_EQ, B_HALF_APPEND_EQ] = map2 (curry save_thm)
["F_HALF_APPEND_EQ", "B_HALF_APPEND_EQ"]
(GCONJ_LIST 2 F_B_HALVES_APPEND_EQ);
(* just the basics about lengths and F/B_HALT *)
val HALT_LENGTHS = store_thm ("HALT_LENGTHS", Term
`!l:'a list. (LENGTH (F_HALT l) = CLG_2 (LENGTH l)) /\
(LENGTH (B_HALT l) = FLR_2 (LENGTH l))`,
GEN_TAC THEN REWRITE_TAC [F_HALT_DEF, FLR_2_DEF, B_HALT_DEF, CLG_2_DEF]
THEN CREL [rich_listTheory.LENGTH_FIRSTN, rich_listTheory.LENGTH_LASTN]
THENL [ALL_TAC,MATCH_MP_TAC DIV_LESS_EQ]
THEN ARITH_TAC);
val [F_HALT_LENGTH, B_HALT_LENGTH] = map2 (curry save_thm)
["F_HALT_LENGTH", "B_HALT_LENGTH"] (GCONJ_LIST 2 HALT_LENGTHS);
(* F_HALT_LENGTH = |- !l. LENGTH (F_HALT l) = CLG_2 (LENGTH l)
B_HALT_LENGTH = |- !l. LENGTH (B_HALT l) = FLR_2 (LENGTH l) *)
(* explicit expressions for the half_lengths eases the proofs of the
following characteristic disjunctions, F_B_HALVES_OR, F_B_HALTS_OR. *)
val F_B_HALVES_OR = store_thm ("F_B_HALVES_OR", Term
`!l:'a list.(LENGTH (F_HALF l) = LENGTH (B_HALF l)) \/
(LENGTH (F_HALF l) + 1 = LENGTH (B_HALF l))`,
REWRITE_TAC [HALF_LENGTHS, FLR_CLG_2_OR]);
val F_B_HALTS_OR = store_thm ("F_B_HALTS_OR", Term
`!l:'a list.(LENGTH (F_HALT l) = LENGTH (B_HALT l)) \/
(LENGTH (F_HALT l) = LENGTH (B_HALT l) + 1)`,
REWRITE_TAC [HALT_LENGTHS, CLG_FLR_2_OR]);
(* The following are useful in conjunction with Hol_defn, tgoal/tprove. *)
val HALVES_SHORTER = store_thm ("HALVES_SHORTER", Term
`!l:'a list. LENGTH l > 1 ==> LENGTH (F_HALF l) < LENGTH l /\
LENGTH (B_HALF l) < LENGTH l`,
REWRITE_TAC [HALF_LENGTHS] THEN MATCH_ACCEPT_TAC FLR_CLG_2_LESS);
val [F_HALF_SHORTER, B_HALF_SHORTER] = map2 (curry save_thm)
["F_HALF_SHORTER", "B_HALF_SHORTER"] (GCONJ_LIST 2 HALVES_SHORTER);
(* F_HALF_SHORTER = |- !l. LENGTH l > 1 ==> LENGTH (F_HALF l) < LENGTH l
B_HALF_SHORTER = |- !l. LENGTH l > 1 ==> LENGTH (B_HALF l) < LENGTH l *)
val HALTS_SHORTER = store_thm ("HALTS_SHORTER", Term
`!l:'a list. LENGTH l > 1 ==> LENGTH (B_HALT l) < LENGTH l /\
LENGTH (F_HALT l) < LENGTH l`,
REWRITE_TAC [HALT_LENGTHS] THEN MATCH_ACCEPT_TAC FLR_CLG_2_LESS);
val [B_HALT_SHORTER, F_HALT_SHORTER] = map2 (curry save_thm)
["B_HALT_SHORTER", "F_HALT_SHORTER"] (GCONJ_LIST 2 HALTS_SHORTER);
(* F_HALT_SHORTER = |- !l. LENGTH l > 1 ==> LENGTH (F_HALT l) < LENGTH l
B_HALT_SHORTER = |- !l. LENGTH l > 1 ==> LENGTH (B_HALT l) < LENGTH l *)
val LENGTH_1_EXISTS = store_thm ("LENGTH_1_EXISTS", Term
`!l:'a list. (LENGTH l = 1) = (?a. l = [a])`,
GEN_TAC THEN EQ_TAC THEN CONV_TAC (ONCE_DEPTH_CONV num_CONV) THENL
[REWRITE_TAC [LENGTH_CONS] THEN STRIP_TAC
THEN EXISTS_TAC (Term`h:'a`)
THEN LEMMA_TAC (Term`l':'a list = []`) THENSGS CR (impOfEqn LENGTH_NIL)
THEN AR
,STRIP_TAC THEN ASM_REWRITE_TAC [LENGTH]]);
val LENGTH_01_IMP = store_thm ("LENGTH_01_IMP", Term
`!l:'a list. ~(LENGTH l > 1) ==> (l = []) \/ (?a. l = [a])`,
GEN_TAC THEN DISCH_THEN (fn ng1 =>
SUBGOAL_THEN (Term`(LENGTH (l:'a list) = 0) \/ (LENGTH l = 1)`) MP_TAC
THENSGS (MP_TAC ng1 THEN ARITH_TAC))
THEN STRIP_TAC THENL
[ASM_REWRITE_TAC [GSYM LENGTH_NIL]
,ASM_REWRITE_TAC [GSYM LENGTH_1_EXISTS]]);
(* A condition on a pair of functions to be sound for two-piece
induction over numbers *)
val NZ_PIECES = new_definition ("NZ_PIECES", Term
`NZ_PIECES p1 p2 =
(!n. n > 1 ==> (p1 n + p2 n = n) /\ p1 n < n /\ p2 n < n)`);
val (NZ_FLR_CLG_2, NZ_CLG_FLR_2) = GCONJ_PAIR (prove (Term
`NZ_PIECES FLR_2 CLG_2 /\ NZ_PIECES CLG_2 FLR_2`,
CONJ_TAC THEN REWRITE_TAC [NZ_PIECES] THEN GEN_TAC
THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM) THEN MP_TAC (SPEC_ALL FLR_CLG_2_OR)
THEN ARITH_TAC));
(* An induction theorem, num_fold_induction, based on splitting a number
in half, usable with INDUCT_THEN. *)
val num_fold_induction = store_thm ("num_fold_induction", Term
`!P. P 0 /\ P 1 /\
(!n. n > 1 /\ P (FLR_2 n) /\ P (CLG_2 n) ==> P n) ==> !n. P n`,
GEN_TAC THEN STRIP_TAC
THEN INDUCT_THEN COMPLETE_INDUCTION STRIP_ASSUME_TAC
THEN SUBGOAL_THEN (Term`((n = 0) \/ (n = 1)) \/ n > 1`)
(DISJ_CASES_THEN2
(DISJ_CASES_THEN (ASM_REWRITE_TAC o ulist)) ASSUME_TAC)
THENSGS ARITH_TAC
THEN STRIP_ASSUME_TAC (REWRITE_RULE [NZ_PIECES] NZ_FLR_CLG_2)
THEN RES_TAC THEN RES_TAC);
(* The following induction theorem can also be proved by complete
induction, but the following non-inductive proof seems inviting, as
long as num_fold_induction is around anyway. *)
val num_sum_induction = store_thm ("num_sum_induction", Term
`!P. P 0 /\ P 1 /\ (!k m. 0 < k /\ k <= m /\ P k /\ P m ==> P (k + m))
==> (!n. P n)`,
GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC num_fold_induction THEN AR
THEN GEN_TAC THEN STRIP_TAC
THEN SUBGOAL_THEN (Term`n > 1 ==> 0 < FLR_2 n /\ FLR_2 n <= CLG_2 n`)
IMP_RES_TAC
THENSGS (MP_TAC (SPEC_ALL FLR_CLG_2_SUM)
THEN MP_TAC (SPEC_ALL FLR_CLG_2_OR) THEN ARITH_TAC)
THEN CONV_TAC (RAND_CONV (REWR_CONV (GSYM FLR_CLG_2_SUM)))
THEN RES_TAC);
(* Now the matching induction theorems for list splitting; lemmas first.
The first of great generality, but perhaps very limited use; it says we
can stratify "all" of anything according to any attribute, and still have
them all. by_length_lemma & by_WORDLEN_lemma are specializations of it. *)
val by_attribute_lemma = store_thm ("by_attribute_lemma", Term
`!f:'a->'b. !Q. (!l. Q l) = (!n. !l. (f l = n) ==> Q l)`,
REPEAT GEN_TAC THEN EQ_TAC THENL
[DISCH_TAC THEN AR
,REPEAT STRIP_TAC THEN ASSUME_TAC (REFL (Term`(f:'a->'b) l`))
THEN RES_TAC]);
val by_length_lemma = save_thm ("by_length_lemma",
ISPEC (Term`LENGTH:'a list->num`) by_attribute_lemma);
(* by_length_lemma = |- !Q. (!l. Q l) = !n l. (LENGTH l = n) ==> Q l *)
(* NB: next two theorems are an example of use of num_fold_induction. *)
val F_B_HALF_list_induction = store_thm ("F_B_HALF_list_induction", Term
`!P. P [] /\ (!a:'a. P [a]) /\
(!l. LENGTH l > 1 /\ P (F_HALF l) /\ P (B_HALF l) ==> P l) ==>
!l. P l`,
GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [by_length_lemma]
THEN INDUCT_THEN num_fold_induction STRIP_ASSUME_TAC THENL
[GEN_TAC THEN REWRITE_TAC [LENGTH_NIL] THEN DISCH_TAC THEN AR
,REWRITE_TAC [LENGTH_1_EXISTS] THEN REPEAT STRIP_TAC THEN AR
,REPEAT STRIP_TAC
THEN LEMMA_TAC (Term`LENGTH (l:'a list) > 1`) THEN1 AR
THEN MP_TAC (SPEC_ALL HALF_LENGTHS) THEN AR THEN STRIP_TAC
THEN RES_TAC]);
val F_B_HALT_list_induction = store_thm ("F_B_HALT_list_induction", Term
`!P. P [] /\ (!a:'a. P [a]) /\
(!l. LENGTH l > 1 /\ P (F_HALT l) /\ P (B_HALT l) ==> P l) ==>
!l. P l`,
GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [by_length_lemma]
THEN INDUCT_THEN num_fold_induction STRIP_ASSUME_TAC THENL
[GEN_TAC THEN REWRITE_TAC [LENGTH_NIL] THEN DISCH_TAC THEN AR
,REWRITE_TAC [LENGTH_1_EXISTS] THEN REPEAT STRIP_TAC THEN AR
,REPEAT STRIP_TAC
THEN LEMMA_TAC (Term`LENGTH (l:'a list) > 1`) THEN1 AR
THEN MP_TAC (SPEC_ALL HALT_LENGTHS) THEN AR THEN STRIP_TAC
THEN RES_TAC]);
(* More generally, a list can be split into parts of any two non-negative
lengths add that to the length of the original. *)
val ANY_LIST_SPLIT_EXISTS = store_thm ("ANY_LIST_SPLIT_EXISTS", Term
`!l:'a list. !i j. (LENGTH l = i + j) ==>
(?k m. (LENGTH k = i) /\ (LENGTH m = j) /\ (l = APPEND k m))`,
INDUCT_THEN list_induction STRIP_ASSUME_TAC THENL
[REPEAT GEN_TAC THEN CONV_TAC (LAND_CONV SYM_CONV)
THEN REWRITE_TAC [LENGTH, ADD_EQ_0] THEN STRIP_TAC THEN AR
THEN EXISTS_TAC (Term`[]:'a list`) THEN EXISTS_TAC (Term`[]:'a list`)
THEN REWRITE_TAC [LENGTH, APPEND]
,GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THENL
[REWRITE_TAC [ADD, LENGTH] THEN DISCH_TAC
THEN EXISTS_TAC (Term`[]:'a list`) THEN EXISTS_TAC (Term`h:'a :: l`)
THEN ASM_REWRITE_TAC [LENGTH, APPEND]
,REWRITE_TAC [ADD, LENGTH, INV_SUC_EQ]
THEN DISCH_THEN (ANTE_RES_THEN STRIP_ASSUME_TAC)
THEN EXISTS_TAC (Term`h:'a :: k`) THEN EXISTS_TAC (Term`m:'a list`)
THEN ASM_REWRITE_TAC [LENGTH, APPEND]
]]);
(* Using ANY_LIST_SPLIT_EXISTS, we may prove an induction theorem for
lists modelled on num_sum_induction *)
val APPEND_list_induction = store_thm ("APPEND_list_induction", Term
`!P. P [] /\ (!a:'a. P [a]) /\
(!k m. 0 < LENGTH k /\ 0 < LENGTH m /\ P k /\ P m ==>
P (APPEND k m)) ==> (!l. P l)`,
GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC [by_length_lemma]
THEN INDUCT_THEN num_sum_induction STRIP_ASSUME_TAC THENL
[REWRITE_TAC [LENGTH_NIL] THEN REPEAT STRIP_TAC THEN AR
,REWRITE_TAC [LENGTH_1_EXISTS] THEN REPEAT STRIP_TAC THEN AR
,GEN_TAC THEN IMP_RES_TAC LESS_LESS_EQ_TRANS
THEN DISCH_THEN (STRIP_ASSUME_TAC o MATCH_MP ANY_LIST_SPLIT_EXISTS)
THEN AR THEN with_asm "k m" MATCH_MP_TAC
THEN AR THEN CONJ_TAC THEN RES_TAC]);
(* some theorems to do with reversing lists *)
val B_HALT_F_HALF = store_thm ("B_HALT_F_HALF", Term
`!l:'a list. REVERSE (B_HALT l) = F_HALF (REVERSE l)`,
REWRITE_TAC [F_HALF_DEF, B_HALT_DEF, rich_listTheory.LENGTH_REVERSE]
THEN GEN_TAC THEN CRE rich_listTheory.FIRSTN_REVERSE
THEN REWRITE_TAC [FLR_CLG_2_LE]);
val F_HALT_B_HALF = store_thm ("F_HALT_B_HALF", Term
`!l:'a list. REVERSE (F_HALT l) = B_HALF (REVERSE l)`,
REWRITE_TAC [F_HALT_DEF, B_HALF_DEF, rich_listTheory.LENGTH_REVERSE]
THEN GEN_TAC THEN CRE rich_listTheory.LASTN_REVERSE
THEN REWRITE_TAC [FLR_CLG_2_LE]);
val [F_HALF_B_HALT, B_HALF_F_HALT] = map2 (curry save_thm)
["F_HALF_B_HALT", "B_HALF_F_HALT"] (GCONJ_LIST 2 (prove (Term
`!l:'a list. (REVERSE (F_HALF l) = B_HALT (REVERSE l)) /\
(REVERSE (B_HALF l) = F_HALT (REVERSE l))`,
GEN_TAC THEN CONV_TAC (BINOP_CONV (RAND_CONV
(REWR_CONV (GSYM rich_listTheory.REVERSE_REVERSE))))
THEN REWRITE_TAC [B_HALT_F_HALF, F_HALT_B_HALF]
THEN REWRITE_TAC [rich_listTheory.REVERSE_REVERSE])));
(* F_HALF_B_HALT = |- !l. REVERSE (F_HALF l) = B_HALT (REVERSE l)
B_HALF_F_HALT = |- !l. REVERSE (B_HALF l) = F_HALT (REVERSE l) *)
(* ********************************************************************
We now set out to treat words in a way parallel to what is done above
for lists. Mostly this should go by translating theorems about lists
via WORD and UNWORD. *)
val WHI_HALF_DEF = new_recursive_definition {name= "WHI_HALF_DEF",
def= Term`WHI_HALF (WORD (l:'a list)) = WORD (F_HALT l)`,
rec_axiom= word_Axiom};
val WLO_HALF_DEF = new_recursive_definition {name= "WLO_HALF_DEF",
def= Term`WLO_HALF (WORD (l:'a list)) = WORD (B_HALT l)`,
rec_axiom= word_Axiom};
val WHI_HALF = store_thm("WHI_HALF", Term
`!w:'a word::PWORDLEN n. WHI_HALF w = FST (WSPLIT (FLR_2 n) w)`,
CONV_TAC RES_FORALL_CONV THEN INDUCT_THEN word_induction ASSUME_TAC
THEN REWRITE_TAC [IN_PWORDLEN, WSPLIT_DEF, WHI_HALF_DEF, F_HALT_DEF]
THEN GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM)
THEN CRE rich_listTheory.BUTLASTN_FIRSTN
THEN REWRITE_TAC [FLR_CLG_2_LE, CLG_2_SUB]);
val WLO_HALF = store_thm("WLO_HALF", Term
`!w:'a word::PWORDLEN n. WLO_HALF w = SND (WSPLIT (FLR_2 n) w)`,
CONV_TAC RES_FORALL_CONV THEN INDUCT_THEN word_induction ASSUME_TAC
THEN REWRITE_TAC [IN_PWORDLEN, WSPLIT_DEF, WLO_HALF_DEF, B_HALT_DEF]
THEN GEN_TAC THEN DISCH_THEN (SUBST1_TAC o SYM) THEN REFL_TAC);
val [WHI_PWORDLEN, WLO_PWORDLEN] = map2 (curry save_thm)
["WHI_PWORDLEN", "WLO_PWORDLEN"]
(CONJ_LIST 2 (CONV_RULE RES_FORALL_AND_CONV (prove (Term
`!w:'a word::PWORDLEN n. WHI_HALF w IN PWORDLEN (CLG_2 n) /\
WLO_HALF w IN PWORDLEN (FLR_2 n)`,
RESQ_GEN_TAC THEN RESQ_REWRITE1_TAC WHI_HALF
THEN RESQ_REWRITE1_TAC WLO_HALF
THEN REWRITE_TAC [CLG_2_SUB]
THEN CR (CONV_RULE RES_FORALL_CONV (SPEC_ALL WSPLIT_PWORDLEN))
THEN MP_TAC (SPEC_ALL FLR_CLG_2_SUM) THEN ARITH_TAC))));
(* WHI_PWORDLEN = |- !i::PWORDLEN n. WHI_HALF i IN PWORDLEN (CLG_2 n)
WLO_PWORDLEN = |- !i::PWORDLEN n. WLO_HALF i IN PWORDLEN (FLR_2 n) *)
(* another stratification lemma: *)
val by_WORDLEN_lemma = store_thm ("by_WORDLEN_lemma", Term
`!Q. (!w:'a word. Q w) = (!n. (!w::PWORDLEN n. Q w))`,
CONV_TAC (ONCE_DEPTH_CONV RES_FORALL_CONV)
THEN REWRITE_TAC [PWORDLEN] THEN MATCH_ACCEPT_TAC by_attribute_lemma);
val [WHI_WORDLEN, WLO_WORDLEN] = map2 (curry save_thm)
["WHI_WORDLEN", "WLO_WORDLEN"] (GCONJ_LIST 2 (prove (Term
`!w:'a word. (WORDLEN (WHI_HALF w) = CLG_2 (WORDLEN w)) /\
(WORDLEN (WLO_HALF w) = FLR_2 (WORDLEN w))`,
INDUCT_THEN word_induction ASSUME_TAC
THEN REWRITE_TAC [WHI_HALF_DEF,WLO_HALF_DEF,WORDLEN_DEF,HALT_LENGTHS])));
val HI_LO_WCAT = store_thm ("HI_LO_WCAT", Term
`!w:'a word. WCAT (WHI_HALF w, WLO_HALF w) = w`,
INDUCT_THEN word_induction ASSUME_TAC
THEN REWRITE_TAC [WCAT_DEF, WHI_HALF_DEF, WLO_HALF_DEF, F_B_HALTS_APP]);
val HI_LO_OR = store_thm ("HI_LO_OR", Term
`!w:'a word. (WORDLEN (WLO_HALF w) = WORDLEN (WHI_HALF w)) \/
(WORDLEN (WLO_HALF w) + 1 = WORDLEN (WHI_HALF w))`,
REWRITE_TAC [WHI_WORDLEN, WLO_WORDLEN, FLR_CLG_2_OR]);
val UNWORD_HI_LO = store_thm ("UNWORD_HI_LO", Term
`!w:'a word. (UNWORD (WHI_HALF w) = F_HALT (UNWORD w)) /\
(UNWORD (WLO_HALF w) = B_HALT (UNWORD w))`,
INDUCT_THEN word_induction ASSUME_TAC
THEN REWRITE_TAC [WHI_HALF_DEF, WLO_HALF_DEF, UNWORD_INVERTS]);
val IN_PWORDLEN_HALVES = store_thm ("IN_PWORDLEN_HALVES", Term
`!n w:'a word. WLO_HALF w IN PWORDLEN (FLR_2 n) /\
WHI_HALF w IN PWORDLEN (CLG_2 n) = w IN PWORDLEN n`,
REPEAT GEN_TAC THEN EQ_TAC THENL
[STRIP_TAC THEN ONCE_REWRITE_TAC [GSYM CLG_FLR_2_SUM, GSYM HI_LO_WCAT]
THEN CR (CONV_RULE (DEPTH_CONV RES_FORALL_CONV) WCAT_PWORDLEN)
,DISCH_TAC
THEN CRL (map (CONV_RULE RES_FORALL_CONV) [WHI_PWORDLEN, WLO_PWORDLEN])]);
val BIT_WHI_HALF = store_thm ("BIT_WHI_HALF", Term
`!n (w:'a word::PWORDLEN n) j. j < CLG_2 n ==>
(BIT j (WHI_HALF w) = BIT (j + FLR_2 n) w)`,
REPEAT RESQ_STRIP_TAC
THEN RESQ_REWRITE1_TAC WHI_HALF THEN RESQ_REWRITE1_TAC WSPLIT_WSEG1
THENSGS REWRITE_TAC [FLR_CLG_2_LE]
THEN REWRITE_TAC [GSYM CLG_2_SUB]
THEN RESQ_REWRITE1_TAC BIT_WSEG THENFIN REFL_TAC
THEN REWRITE_TAC [CLG_FLR_2_SUM, LESS_EQ_REFL]);
val BIT_WLO_HALF = store_thm ("BIT_WLO_HALF", Term
`!n (w:'a word::PWORDLEN n) j. j < FLR_2 n ==>
(BIT j (WLO_HALF w) = BIT j w)`,
REPEAT RESQ_STRIP_TAC
THEN RESQ_REWRITE1_TAC WLO_HALF THEN RESQ_REWRITE1_TAC WSPLIT_WSEG2
THENSGS REWRITE_TAC [FLR_CLG_2_LE]
THEN RESQ_REWRITE1_TAC BIT_WSEG THENFIN REDUCE_TAC
THEN REDUCE_TAC THEN AR);
(* The following are useful in conjunction with Hol_defn, tgoal/tprove. *)
val WHALVES_SHORTER = store_thm ("WHALVES_SHORTER", Term
`!w:'a word. WORDLEN w > 1 ==> WORDLEN (WLO_HALF w) < WORDLEN w /\
WORDLEN (WHI_HALF w) < WORDLEN w`,
GEN_TAC THEN REWRITE_TAC [WHI_WORDLEN, WLO_WORDLEN]
THEN MATCH_ACCEPT_TAC FLR_CLG_2_LESS);
val [WLO_HALF_SHORTER, WHI_HALF_SHORTER] = map2 (curry save_thm)
["WLO_HALF_SHORTER", "WHI_HALF_SHORTER"] (GCONJ_LIST 2 WHALVES_SHORTER);
(* WLO_HALF_SHORTER =
|- !w. WORDLEN w > 1 ==> WORDLEN (WLO_HALF w) < WORDLEN w
WHI_HALF_SHORTER =
|- !w. WORDLEN w > 1 ==> WORDLEN (WHI_HALF w) < WORDLEN w *)
val WORDLEN_1_EXISTS = store_thm ("WORDLEN_1_EXISTS", Term
`!w:'a word. (WORDLEN w = 1) = (?a. w = WORD [a])`,
INDUCT_THEN word_induction ASSUME_TAC THEN GEN_TAC
THEN REWRITE_TAC [WORDLEN_DEF, LENGTH_1_EXISTS, WORD_11]);
val WORDLEN_01_IMP = store_thm ("WORDLEN_01_IMP", Term
`!w:'a word. ~(WORDLEN w > 1) ==> (w = WORD []) \/ (?a. w = WORD [a])`,
INDUCT_THEN word_induction ASSUME_TAC THEN GEN_TAC
THEN REWRITE_TAC [WORDLEN_DEF, WORD_11]
THEN MATCH_ACCEPT_TAC LENGTH_01_IMP);
(* Recall word_induction = |- !P. (!l. P (WORD l)) ==> !w. P w *)
val HI_LO_word_induction = store_thm ("HI_LO_word_induction", Term
`!P. P (WORD []) /\ (!a:'a. P (WORD [a])) /\ (!n. n > 1 ==>
(!w::PWORDLEN n. P (WHI_HALF w) /\ P (WLO_HALF w) ==> P w)) ==>
(!w. P w)`,
CONV_TAC (DEPTH_CON...