+ (* STOP *)
+ |#Hcomp1 #Hsrc cases (Hsrc ? (refl ??)) -Hsrc #ls0 * #rs0 #Hdst
+ @False_ind lapply (Hcomp1 ?) [%2 %1 %1 >Hmid_src normalize
+ @(not_to_not ??? (\Pf Hceq)) #H destruct //] #Hintape
+ >Hintape in Hc; >Hmid_src #Hc lapply (Hc ? (refl …)) -Hc
+ >(Hnotend c_src) // normalize #H destruct (H)
+ ]
+ ]
+]
+qed.
+*)
+
+definition match_step ≝ λsrc,dst,sig,n,is_startc,is_endc.
+ compare src dst sig n is_endc ·
+ (ifTM ?? (inject_TM ? (test_char ? (λa.is_endc a == false)) n src)
+ (ifTM ?? (inject_TM ? (test_null ?) n src)
+ (single_finalTM ??
+ (parmove src dst sig n L is_startc · (inject_TM ? (move_r ?) n dst)))
+ (nop …) tc_true)
+ (nop …)
+ tc_true).
+
+definition R_match_step_false ≝
+ λsrc,dst,sig,n,is_endc.λint,outt: Vector (tape sig) (S n).
+ ∀ls,x,xs,end,rs.
+ nth src ? int (niltape ?) = midtape sig ls x (xs@end::rs) →
+ (∀c0. memb ? c0 (x::xs) = true → is_endc c0 = false) → is_endc end = true →
+ ((current sig (nth dst (tape sig) int (niltape sig)) = None ?) ∧ outt = int) ∨
+ (∃ls0,rs0.
+ nth dst ? int (niltape ?) = midtape sig ls0 x (xs@rs0) ∧
+ ∀rsj,c.
+ rs0 = c::rsj →
+ outt = change_vec ??
+ (change_vec ?? int (midtape sig (reverse ? xs@x::ls) end rs) src)
+ (midtape sig (reverse ? xs@x::ls0) c rsj) dst).
+
+definition R_match_step_true ≝
+ λsrc,dst,sig,n,is_startc,is_endc.λint,outt: Vector (tape sig) (S n).
+ ∀s.current sig (nth src (tape sig) int (niltape sig)) = Some ? s →
+ is_startc s = true →
+ (∀c.c ∈ right ? (nth src (tape sig) int (niltape sig)) = true → is_startc c = false) →
+ current sig (nth dst (tape sig) int (niltape sig)) ≠ None ? ∧
+ (∀s1.current sig (nth dst (tape sig) int (niltape sig)) = Some ? s1 → s ≠ s1 →
+ outt = change_vec ?? int
+ (tape_move … (nth dst ? int (niltape ?)) (Some ? 〈s1,R〉)) dst ∧ is_endc s = false) ∧
+ (∀ls,x,xs,ci,rs,ls0,rs0.
+ nth src ? int (niltape ?) = midtape sig ls x (xs@ci::rs) →
+ nth dst ? int (niltape ?) = midtape sig ls0 x (xs@rs0) →
+ (∀c0. memb ? c0 (x::xs) = true → is_endc c0 = false) →
+ (∀cj,rs1.rs0 = cj::rs1 → ci ≠ cj →
+ (outt = change_vec ?? int
+ (tape_move … (nth dst ? int (niltape ?)) (Some ? 〈x,R〉)) dst ∧ is_endc ci = false)) ∧
+ (rs0 = [ ] →
+ outt = change_vec ??
+ (change_vec ?? int (midtape sig (reverse ? xs@x::ls) ci rs) src)
+ (mk_tape sig (reverse ? xs@x::ls0) (None ?) [ ]) dst)).
+
+lemma sem_match_step :
+ ∀src,dst,sig,n,is_startc,is_endc.src ≠ dst → src < S n → dst < S n →
+ match_step src dst sig n is_startc is_endc ⊨
+ [ inr ?? (inr ?? (inl … (inr ?? (inr ?? start_nop)))) :
+ R_match_step_true src dst sig n is_startc is_endc,
+ R_match_step_false src dst sig n is_endc ].
+#src #dst #sig #n #is_startc #is_endc #Hneq #Hsrc #Hdst
+(* test_null versione multi? *)
+@(acc_sem_seq_app sig n … (sem_compare src dst sig n is_endc Hneq Hsrc Hdst)
+ (acc_sem_if ? n … (sem_test_char_multi sig (λa.is_endc a == false) n src (le_S_S_to_le … Hsrc))
+ (acc_sem_if ? n … (sem_test_null sig (λa.is_endc a == false) n src (le_S_S_to_le … Hsrc))
+
+ sem_seq …
+ (sem_parmoveL ???? is_startc Hneq Hsrc Hdst)
+ (sem_inject … dst (le_S_S_to_le … Hdst) (sem_move_r ? )))
+ (sem_nop …)))
+[#ta #tb #tc * #Hcomp1 #Hcomp2 * #td * * * #c * #Hcurtc #Hcend #Htd >Htd -Htd
+ #Htb #s #Hcurta_src #Hstart #Hnotstart % [ %
+ [#Hdst_none @daemon
+ | #s1 #Hcurta_dst #Hneqss1
+ lapply Htb lapply Hcurtc -Htb -Hcurtc >(?:tc=ta)
+ [|@Hcomp1 %2 % % >Hcurta_src >Hcurta_dst @(not_to_not … Hneqss1) #H destruct (H) % ]
+ #Hcurtc * #te * * #_ #Hte >Hte [2: %1 %1 %{s} % //]
+ whd in ⊢ (%→?); * * #_ #Htbdst #Htbelse %
+ [ @(eq_vec … (niltape ?)) #i #Hi cases (decidable_eq_nat i dst) #Hidst
+ [ >Hidst >nth_change_vec // cases (current_to_midtape … Hcurta_dst)
+ #ls * #rs #Hta_mid >(Htbdst … Hta_mid) >Hta_mid cases rs //
+ | >nth_change_vec_neq [|@sym_not_eq //] @sym_eq @Htbelse @sym_not_eq // ]
+ | >Hcurtc in Hcurta_src; #H destruct (H) cases (is_endc s) in Hcend;