- ] #Hnoteq %2
- cut (is_bit d' = true)
- [cases la in H3;
- [normalize in ⊢ (%→?); #H destruct //
- |#x #tl #H @(Hl3 〈d',false〉)
- normalize in H; destruct @memb_append_l2 @memb_hd
- ]
- ] #Hd'
- >Htapec in Hor; -Htapec *
- [* #taped * whd in ⊢ (%→?); #H @False_ind
- cases (H … (refl …)) >(bit_not_grid ? Hd') #Htemp destruct (Htemp)
- |* #taped * whd in ⊢ (%→?); #H cases (H … (refl …)) -H #_
- #Htaped * #tapee * whd in ⊢ (%→?); #Htapee
- <(associative_append ? lc (〈comma,false〉::l4)) in Htaped; #Htaped
- cases (Htapee … Htaped ???) -Htaped -Htapee
- [* #rs3 * * (* we proceed by cases on rs4 *)
- [(* rs4 is empty : the case is absurd since the tape
- cannot end with a bar *)
- * #d * #b * * * #Heq1 @False_ind
- cut (∀A,l1,l2.∀a:A. a::l1@l2=(a::l1)@l2) [//] #Hcut
- >Hcut in Htable; >H3 >associative_append
- normalize >Heq1 >Hcut <associative_append >Hcut
- <associative_append #Htable @(absurd … Htable)
- @last_of_table
- |(* rs4 not empty *)
- * #d2 #b2 #rs3' * #d * #b * * * #Heq1 #Hnobars
- cut (memb STape 〈d2,b2〉 (l2@〈bar,false〉::〈c1,false〉::l3@〈comma,false〉::l4) = true)
- [@memb_append_l2 @memb_cons
- cut (∀A,l1,l2.∀a:A. a::l1@l2=(a::l1)@l2) [//] #Hcut
- >Hcut >H3 >associative_append @memb_append_l2
- @memb_cons >Heq1 @memb_append_l2 @memb_cons @memb_hd] #d2intable
- cut (is_grid d2 = false)
- [@(no_grids_in_table … Htable … 〈d2,b2〉 d2intable)] #Hd2
- cut (b2 = false)
- [@(no_marks_in_table … Htable … 〈d2,b2〉 d2intable)] #Hb2
- >Hb2 in Heq1; #Heq1 -Hb2 -b2
- whd in ⊢ ((???%)→?); #Htemp destruct (Htemp) #Htapee >Htapee -Htapee *
- [(* we know current is not grid *)
- * #tapef * whd in ⊢ (%→?); #Htapef
- cases (Htapef … (refl …)) >Hd2 #Htemp destruct (Htemp)
- |* #tapef * whd in ⊢ (%→?); #Htapef
- cases (Htapef … (refl …)) #_ -Htapef #Htapef
- * #tapeg >Htapef -Htapef *
- (* move_l *)
- whd in ⊢ (%→?);
- #H lapply (H … (refl …)) whd in ⊢ (???%→?); -H #Htapeg
- >Htapeg -Htapeg
- (* init_current *)
- whd in ⊢ (%→?); #Htapeout
- %1 cases (some_option_hd ? (reverse ? (reverse ? la)) 〈c',true〉)
- * #c00 #b00 #Hoption
- lapply
- (Htapeout (reverse ? rs3 @〈d',false〉::reverse ? la@reverse ? (l2@[〈bar,false〉])@(〈grid,false〉::reverse ? lb))
- c' (reverse ? la) false ls bar (〈d2,true〉::rs3'@〈grid,false〉::rs) c00 b00 ?????) -Htapeout
- [whd in ⊢ (??(??%??)?); @eq_f3 [2:%|3: %]
- >associative_append
- generalize in match (〈c',true〉::reverse ? la@〈grid,false〉::ls); #l
- whd in ⊢ (???(???%)); >associative_append >associative_append %
- |>reverse_cons @Hoption
- |cases la in H2;
- [normalize in ⊢ (%→?); #Htemp destruct (Htemp)
- @injective_notb @notgridc
- |#x #tl normalize in ⊢ (%→?); #Htemp destruct (Htemp)
- @bit_not_grid @(Hl1bars 〈c',false〉) @memb_append_l2 @memb_hd
- ]
- |cut (only_bits (la@(〈c',false〉::lb)))
- [<H2 whd #c0 #Hmemb cases (orb_true_l … Hmemb)
- [#eqc0 >(\P eqc0) @Hc |@Hl1bars]
- |#Hl1' #x #Hx @bit_not_grid @Hl1'
- @memb_append_l1 @daemon
- ]
- |@daemon
- |>reverse_append >reverse_cons >reverse_reverse
- >reverse_append >reverse_reverse
- >reverse_cons >reverse_append >reverse_reverse
- >reverse_append >reverse_cons >reverse_reverse
- >reverse_reverse
- #Htapeout % [@Hnoteq]
- @(ex_intro … d2)
- cut (∃rs32.rs3 = lc@〈comma,false〉::rs32)
- [ (*cases (tech_split STape (λc.c == 〈bar,false〉) l4)
- [
- | * #l41 * * #cbar #bfalse * #l42 * * #Hbar #Hl4 #Hl41
- @(ex_intro ?? l41) >Hl4 in Heq1; #Heq1
-
- cut (sublist … lc l3)
- [ #x #Hx cases la in H3;
- [ normalize #H3 destruct (H3) @Hx
- | #p #la' normalize #Hla' destruct (Hla')
- @memb_append_l2 @memb_cons @Hx ] ] #Hsublist*)
- @daemon]
- * #rs32 #Hrs3
- (* cut
- (〈c1,false〉::l3@〈comma,false〉::l4= la@〈d',false〉::rs3@〈bar,false〉::〈d2,b2〉::rs3')
- [@daemon] #Hcut *)
- cut (l4=rs32@〈bar,false〉::〈d2,false〉::rs3')
- [ >Hrs3 in Heq1; @daemon ] #Hl4
- @(ex_intro … rs32) @(ex_intro … rs3') %
- [@Hl4
- |>Htapeout @eq_f2
- [@daemon
- |(*>Hrs3 *)>append_cons
- > (?:l1@〈grid,false〉::l2@〈bar,false〉::〈c1,false〉::l3@〈comma,false〉::rs32@〈bar,false〉::〈d2,true〉::rs3'@〈grid,false〉::rs
- = (l1@〈grid,false〉::l2@〈bar,false〉::〈c1,false〉::l3@〈comma,false〉::rs32@[〈bar,false〉])@〈d2,true〉::rs3'@〈grid,false〉::rs)
- [|>associative_append normalize
- >associative_append normalize
- >associative_append normalize
- >associative_append normalize
- % ]
- @eq_f2 [|%]
- @(injective_append … (〈d2,false〉::rs3'))
- >(?:(la@[〈c',false〉])@((((lb@[〈grid,false〉])@l2@[〈bar,false〉])@la)@[〈d',false〉])@rs3
- =((la@〈c',false〉::lb)@([〈grid,false〉]@l2@[〈bar,false〉]@la@[〈d',false〉]@rs3)))
- [|>associative_append >associative_append
- >associative_append >associative_append >associative_append
- >associative_append >associative_append % ]
- <H2 normalize (* <Hrs3 *)
- >associative_append >associative_append >associative_append
- @eq_f normalize @eq_f >associative_append
- >associative_append @eq_f normalize @eq_f
- >(append_cons ? 〈d',false〉) >associative_append
- <Heq1 >Hl4 <associative_append <append_cons
- <H3
- >associative_append normalize
- >associative_append normalize %
- ]
- ]
- ]
- ]
- ]
- |* #Hnobars #Htapee >Htapee -Htapee *
- [whd in ⊢ (%→?); * #tapef * whd in ⊢ (%→?); #Htapef
- cases (Htapef … (refl …)) -Htapef #_ #Htapef >Htapef -Htapef
- whd in ⊢ (%→?); #Htapeout %2
- >(Htapeout … (refl …)) %
- [ %
- [ @Hnoteq
- | whd #x #Hx @Hnobars @memb_append_l2 @memb_cons //
- ]
- | %
- ]
- |whd in ⊢ (%→?); * #tapef * whd in ⊢ (%→?); #Htapef
- cases (Htapef … (refl …)) -Htapef
- whd in ⊢ ((??%?)→?); #Htemp destruct (Htemp)
- ]
- |(* no marks in table *)
- #x #membx @(no_marks_in_table … Htable)
- @memb_append_l2 @memb_cons
- cut (∀A,l1,l2.∀a:A. a::l1@l2=(a::l1)@l2) [//] #Hcut >Hcut
- >H3 >associative_append @memb_append_l2 @memb_cons @membx
- |(* no grids in table *)
- #x #membx @(no_grids_in_table … Htable)
- @memb_append_l2 @memb_cons
- cut (∀A,l1,l2.∀a:A. a::l1@l2=(a::l1)@l2) [//] #Hcut >Hcut
- >H3 >associative_append @memb_append_l2 @memb_cons @membx
- |whd in ⊢ (??%?); >(bit_not_grid … Hd') >(bit_not_bar … Hd') %
- ]
- ]
- |#x #membx @(no_marks_in_table … Htable)
- @memb_append_l2 @memb_cons @memb_cons @memb_append_l1 @membx
- |#x #membx @(no_marks_in_table … Htable)
- cases (memb_append … membx) -membx #membx
- [@memb_append_l1 @membx | @memb_append_l2 >(memb_single … membx) @memb_hd]
- |>associative_append %
- ]
- ]
+ ]
+ ]
+ ]
+qed.
+
+lemma generic_match_to_match_in_table :
+ ∀n,T.table_TM n T →
+ ∀qin,cin,qout,cout,mv.|qin| = n → |qout| = n →
+ only_bits qin → only_bits qout →
+ bit_or_null (\fst cin) = true → bit_or_null (\fst cout) = true →
+ bit_or_null (\fst mv) = true →
+ ∀t1,t2.
+ T = (t1@〈bar,false〉::qin@cin::〈comma,false〉::qout@cout::〈comma,false〉::[mv])@t2 →
+ match_in_table n qin cin qout cout mv T.
+#n #T #Htable #qin #cin #qout #cout #mv #Hlenqin #Hlenqout
+#Hqinbits #Hqoutbits #Hcin #Hcout #Hmv
+elim Htable
+[ * [ #t2 normalize in ⊢ (%→?); #Hfalse destruct (Hfalse)
+ | #c0 #t1 #t2 normalize in ⊢ (%→?); #Hfalse destruct (Hfalse) ]
+| #tuple #T0 #H1 #Htable0#IH #t1 #t2 #HT cases H1 #qin0 * #cin0 * #qout0 * #cout0 * #mv0
+ * * * * * * * * * *
+ #Hqin0marks #Hqout0marks #Hqin0bits #Hqout0bits #Hcin0 #Hcout0 #Hmv0 #Hcout0mv0
+ #Hlenqin0 #Hlenqout0 #Htuple
+ lapply (generic_match_to_match_in_table_tech n ? T0 t1
+ (qin@cin::〈comma,false〉::qout@[cout;〈comma,false〉;mv]@t2) H1) #Htmp
+ >Htuple in H1; #H1
+ lapply (ttm_cons … T0 H1 Htable0) <Htuple in ⊢ (%→?); >HT
+ >associative_append normalize >associative_append normalize
+ >associative_append #Htable cases (Htmp Htable ?)
+ [ #Ht1 >Htuple in HT; >Ht1 normalize in ⊢ (??%%→?);
+ >associative_append >associative_append #HT
+ cut (qin0 = qin ∧ (〈cin0,false〉 = cin ∧ (qout0 = qout ∧
+ (〈cout0,false〉 = cout ∧ (〈mv0,false〉 = mv ∧ T0 = t2)))))
+ [ lapply (cons_injective_r ????? HT) -HT #HT
+ lapply (append_l1_injective … HT) [ >Hlenqin @Hlenqin0 ]
+ #Hqin % [ @Hqin ] -Hqin
+ lapply (append_l2_injective … HT) [ >Hlenqin @Hlenqin0 ] -HT #HT
+ lapply (cons_injective_l ????? HT) #Hcin % [ @Hcin ] -Hcin
+ lapply (cons_injective_r ????? HT) -HT #HT
+ lapply (cons_injective_r ????? HT) -HT
+ >associative_append >associative_append #HT
+ lapply (append_l1_injective … HT) [ >Hlenqout @Hlenqout0 ]
+ #Hqout % [ @Hqout ] -Hqout
+ lapply (append_l2_injective … HT) [ >Hlenqout @Hlenqout0 ] -HT normalize #HT
+ lapply (cons_injective_l ????? HT) #Hcout % [ @Hcout ] -Hcout
+ lapply (cons_injective_r ????? HT) -HT #HT
+ lapply (cons_injective_r ????? HT) -HT #HT
+ lapply (cons_injective_l ????? HT) #Hmv % [ @Hmv ] -Hmv
+ @(cons_injective_r ????? HT) ]
+ -HT * #Hqin * #Hcin * #Hqout * #Hcout * #Hmv #HT0
+ >(?:〈bar,false〉::qin0@(〈cin0,false〉::〈comma,false〉::qout0@
+ [〈cout0,false〉;〈comma,false〉;〈mv0,false〉])@T0 = tuple@T0)
+ [ >Htuple >Hqin >Hqout >Hcin >Hcout >Hmv % //
+ | >Htuple normalize >associative_append normalize >associative_append
+ normalize >associative_append % ]
+ | * #T3 #HT3 >HT3 in HT; >associative_append; >associative_append #HT
+ lapply (append_l2_injective … HT) // -HT #HT %2 //
+ @(IH T3 t2) >HT >associative_append %
+ |>HT >associative_append normalize >associative_append normalize
+ >associative_append % ]
+]