From paul%tina.stanford.edu Fri, 2 Jun 89
Date: Fri, 2 Jun 89 10:21:50 PDT
From: paul%tina.stanford.edu (Paul N. Loewenstein)
To: info-hol@clover.ucdavis.edu
Subject: Left-to-right, right-to-left and zero-length
Status: RO

It is easy to make the theory of lists symmetrical, left-to-right or
right-to-left.

% CONS from other end of list %

let SNOC_DEF = new_list_rec_definition (`SNOC_DEF`,
 "(SNOC (d:*) ([]:(*)list) = [d]) /\
  (SNOC d (CONS h t) = CONS h (SNOC d t))");;

let REV = new_list_rec_definition (`REV`,
 "(rev [] = []) /\
  (rev (CONS (h:*) l) = SNOC h (rev l))");;

let REV_SNOC =
 TAC_PROOF (([],"!(d:*) l. rev (SNOC d l) = CONS d (rev l)"),
  GEN_TAC THEN LIST_INDUCT_TAC THEN
  ASM_REWRITE_TAC[SNOC_DEF;REV]);;

let REV_REV = TAC_PROOF (([],"!l:(*)list. rev (rev l) = l"),
 LIST_INDUCT_TAC THEN
 ASM_REWRITE_TAC[REV;REV_SNOC]);;



let forall_rev = TAC_PROOF (([], "!P. (!t:(*)list. P(rev t)) = (!t. P t)"),
 GEN_TAC THEN
 EQ_TAC THEN
 DISCH_TAC THEN
 GEN_TAC THEN
 POP_ASSUM (ACCEPT_TAC o (REWRITE_RULE[REV_REV] o (SPEC "rev t:(*)list")))
);;

let f_rev_lemma = TAC_PROOF (([],
 "!f1 f2. ((\x. (f1:(*)list->**) (rev x)) = (\x. f2 (rev x))) = (f1 = f2)"),
 REPEAT GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL
 [
  POP_ASSUM (\x.ACCEPT_TAC (EXT (REWRITE_RULE[REV_REV]
   (GEN "x:(*)list" (BETA_RULE (AP_THM x "rev (x:(*)list)"))))))
 ;
  ASM_REWRITE_TAC[]
 ]);;

let SNOC_Axiom = TAC_PROOF (([], "!(x:**) (f:** -> (* -> ((*)list -> **))).
  ?! fun. (fun[] = x) /\ (!h t. fun(SNOC h t) = f(fun t)h t)"),
 REPEAT GEN_TAC THEN
 REWRITE_TAC[EXISTS_UNIQUE_DEF] THEN CONV_TAC (REDEPTH_CONV BETA_CONV) THEN
 STRIP_ASSUME_TAC (CONV_RULE (REDEPTH_CONV BETA_CONV)
  (REWRITE_RULE [EXISTS_UNIQUE_DEF]
   (REWRITE_RULE[REV_REV] (BETA_RULE (SPECL
 ["x:**";"(\ft h t. f ft h (rev t)):** -> (* -> ((*)list -> **))"]
 (PURE_ONCE_REWRITE_RULE [SYM (CONJUNCT1 REV);PURE_ONCE_REWRITE_RULE
 [SYM (SPEC_ALL REV_SNOC)] (BETA_RULE
 (SPEC "\t:(*)list.fun(CONS h t) = (f:** -> (* -> ((*)list -> **)))(fun t)h t"
 (CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) forall_rev)))] list_Axiom))))
  )) THEN
 CONJ_TAC THENL
 [
  EXISTS_TAC "(fun:(*)list->**) o rev" THEN
  REWRITE_TAC[o_DEF] THEN BETA_TAC THEN
  ASM_REWRITE_TAC[]
 ;
  REPEAT GEN_TAC THEN
  POP_ASSUM (ACCEPT_TAC o SPEC_ALL o REWRITE_RULE[REV_REV;f_rev_lemma] o
   BETA_RULE o REWRITE_RULE[o_DEF] o
   SPECL ["(x' o rev):(*)list->**"; "(y o rev):(*)list->**"])
 ]);;

let SNOC_INDUCT = prove_induction_thm SNOC_Axiom;;
let SNOC_CASES = prove_cases_thm SNOC_INDUCT;;
let SNOC_11 = prove_constructors_one_one SNOC_Axiom;;
let SNOC_ONE_ONE = GEN_ALL (fst (EQ_IMP_RULE (SPEC_ALL (SNOC_11))));;
let NOT_NIL_SNOC = prove_constructors_distinct SNOC_Axiom;;
let NOT_SNOC_NIL = CONV_RULE (ONCE_DEPTH_CONV SYM_CONV) NOT_NIL_SNOC;;


Now you can define recursive list functions either way, and do induction
either way.

I am sending my lists theory to Tom, for possible inclusion in future
releases.

       Paul.


