- ∀ls,c,rs1,rs2.
- (* c non può essere un separatore ... speriamo *)
- t1 = midtape ? ls c (rs1@grid::rs2) →
- memb ? grid rs1 = false → bar_or_grid c = false →
- (∃rs3,rs4,d,b.rs1 = rs3 @ bar :: rs4 ∧
- memb ? bar rs3 = false ∧
- Some ? 〈d,b〉 = option_hd ? (rs4@grid::rs2) ∧
- t2 = midtape ? (bar::reverse ? rs3@c::ls) 〈d,true〉 (tail ? (rs4@grid::rs2)))
- ∨
- (memb ? bar rs1 = false ∧
- t2 = midtape ? (reverse ? rs1@c::ls) grid rs2).
-
-axiom tech_split :
- ∀A:DeqSet.∀f,l.
- (∀x.memb A x l = true → f x = false) ∨
- (∃l1,c,l2.f c = true ∧ l = l1@c::l2 ∧ ∀x.memb ? x l1 = true → f c = false).
-(*#A #f #l elim l
-[ % #x normalize #Hfalse *)
-
-theorem sem_mark_next_tuple :
- Realize ? mark_next_tuple R_mark_next_tuple.
-#intape
-lapply (sem_seq ? (adv_to_mark_r ? bar_or_grid)
- (ifTM ? (test_char ? is_bar) (mark ?) (nop ?) 1) ????)
-[@sem_if //
-| //
-|||#Hif cases (Hif intape) -Hif
- #j * #outc * #Hloop * #ta * #Hleft #Hright
- @(ex_intro ?? j) @ex_intro [|% [@Hloop] ]
- -Hloop
- #ls #c #rs1 #rs2 #Hrs #Hrs1 #Hc
- cases (Hleft … Hrs)
- [ * #Hfalse >Hfalse in Hc; #Htf destruct (Htf)
- | * #_ #Hta cases (tech_split ? is_bar rs1)
- [ #H1 lapply (Hta rs1 grid rs2 (refl ??) ? ?)
- [ (* Hrs1, H1 *) @daemon
- | (* bar_or_grid grid = true *) @daemon
- | -Hta #Hta cases Hright
- [ * #tb * whd in ⊢ (%→?); #Hcurrent
- @False_ind cases(Hcurrent grid ?)
- [ #Hfalse (* grid is not a bar *) @daemon
- | >Hta % ]
- | * #tb * whd in ⊢ (%→?); #Hcurrent
- cases (Hcurrent grid ?)
- [ #_ #Htb whd in ⊢ (%→?); #Houtc
- %2 %
- [ (* H1 *) @daemon
- | >Houtc >Htb >Hta % ]
- | >Hta % ]
+ ∀ls,c,rs.t1 = midtape (FinProd … FSUnialpha FinBool) ls c rs →
+ (∀c'.bit_or_null c' = false → c = 〈c',true〉 → t2 = midtape ? ls 〈c',false〉 rs) ∧
+ (∀c'. c = 〈c',false〉 → t2 = t1) ∧
+ ∀b,b0,bs,b0s,l1,l2.
+ |bs| = |b0s| →
+ (∀c.memb (FinProd … FSUnialpha FinBool) c bs = true → bit_or_null (\fst c) = true) →
+ (∀c.memb (FinProd … FSUnialpha FinBool) c b0s = true → bit_or_null (\fst c) = true) →
+ (∀c.memb ? c bs = true → is_marked ? c = false) →
+ (∀c.memb ? c b0s = true → is_marked ? c = false) →
+ (∀c.memb ? c l1 = true → is_marked ? c = false) →
+ c = 〈b,true〉 → bit_or_null b = true →
+ rs = bs@〈grid,false〉::l1@〈b0,true〉::b0s@〈comma,false〉::l2 →
+ (〈b,true〉::bs = 〈b0,true〉::b0s ∧
+ t2 = midtape ? (reverse ? bs@〈b,false〉::ls)
+ 〈grid,false〉 (l1@〈b0,false〉::b0s@〈comma,true〉::l2)) ∨
+ (∃la,c',d',lb,lc.c' ≠ d' ∧
+ 〈b,false〉::bs = la@〈c',false〉::lb ∧
+ 〈b0,false〉::b0s = la@〈d',false〉::lc ∧
+ t2 = midtape (FinProd … FSUnialpha FinBool) (reverse ? la@
+ reverse ? l1@
+ 〈grid,false〉::
+ reverse ? lb@
+ 〈c',true〉::
+ reverse ? la@ls)
+ 〈d',false〉 (lc@〈comma,false〉::l2)).
+
+lemma wsem_compare : WRealize ? compare R_compare.
+#t #i #outc #Hloop
+lapply (sem_while ?????? sem_comp_step t i outc Hloop) [%]
+-Hloop * #t1 * #Hstar @(star_ind_l ??????? Hstar)
+[ #tapea whd in ⊢ (%→?); #Rfalse #ls #c #rs #Htapea %
+ [ %
+ [ #c' #Hc' #Hc lapply (Rfalse … Htapea) -Rfalse * >Hc
+ whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
+ | #c' #Hc lapply (Rfalse … Htapea) -Rfalse * #_
+ #Htrue @Htrue ]
+ | #b #b0 #bs #b0s #l1 #l2 #Hlen #Hbs1 #Hb0s1 #Hbs2 #Hb0s2 #Hl1 #Hc
+ cases (Rfalse … Htapea) -Rfalse >Hc whd in ⊢ (??%?→?);#Hfalse destruct (Hfalse)
+ ]
+| #tapea #tapeb #tapec #Hleft #Hright #IH #Htapec lapply (IH Htapec) -Htapec -IH #IH
+ whd in Hleft; #ls #c #rs #Htapea cases (Hleft … Htapea) -Hleft
+ #c' * #Hc >Hc cases (true_or_false (bit_or_null c')) #Hc'
+ [2: *
+ [ * >Hc' #H @False_ind destruct (H)
+ | * #_ #Htapeb cases (IH … Htapeb) * #_ #H #_ %
+ [%
+ [#c1 #Hc1 #Heqc destruct (Heqc) <Htapeb @(H c1) %
+ |#c1 #Hfalse destruct (Hfalse)
+ ]
+ |#b #b0 #bs #b0s #l1 #l2 #_ #_ #_ #_ #_ #_
+ #Heq destruct (Heq) >Hc' #Hfalse @False_ind destruct (Hfalse)
+ ]
+ ]
+ |#Hleft %
+ [ %
+ [ #c'' #Hc'' #Heq destruct (Heq) >Hc'' in Hc'; #H destruct (H)
+ | #c0 #Hfalse destruct (Hfalse)
+ ]
+ |#b #b0 #bs #b0s #l1 #l2 #Hlen #Hbs1 #Hb0s1 #Hbs2 #Hb0s2 #Hl1
+ #Heq destruct (Heq) #_ #Hrs cases Hleft -Hleft
+ [2: * >Hc' #Hfalse @False_ind destruct ] * #_
+ @(list_cases2 … Hlen)
+ [ #Hbs #Hb0s generalize in match Hrs; >Hbs in ⊢ (%→?); >Hb0s in ⊢ (%→?);
+ -Hrs #Hrs normalize in Hrs; #Hleft cases (Hleft ????? Hrs ?) -Hleft
+ [ * #Heqb #Htapeb cases (IH … Htapeb) -IH * #IH #_ #_
+ % %
+ [ >Heqb >Hbs >Hb0s %
+ | >Hbs >Hb0s @IH %
+ ]
+ |* #Hneqb #Htapeb %2
+ @(ex_intro … [ ]) @(ex_intro … b)
+ @(ex_intro … b0) @(ex_intro … [ ])
+ @(ex_intro … [ ]) %
+ [ % [ % [@sym_not_eq //| >Hbs %] | >Hb0s %]
+ | cases (IH … Htapeb) -IH * #_ #IH #_ >(IH ? (refl ??))
+ @Htapeb
+ ]
+ | @Hl1 ]
+ | * #b' #bitb' * #b0' #bitb0' #bs' #b0s' #Hbs #Hb0s
+ generalize in match Hrs; >Hbs in ⊢ (%→?); >Hb0s in ⊢ (%→?);
+ cut (bit_or_null b' = true ∧ bit_or_null b0' = true ∧
+ bitb' = false ∧ bitb0' = false)
+ [ % [ % [ % [ >Hbs in Hbs1; #Hbs1 @(Hbs1 〈b',bitb'〉) @memb_hd
+ | >Hb0s in Hb0s1; #Hb0s1 @(Hb0s1 〈b0',bitb0'〉) @memb_hd ]
+ | >Hbs in Hbs2; #Hbs2 @(Hbs2 〈b',bitb'〉) @memb_hd ]
+ | >Hb0s in Hb0s2; #Hb0s2 @(Hb0s2 〈b0',bitb0'〉) @memb_hd ]
+ | * * * #Ha #Hb #Hc #Hd >Hc >Hd
+ #Hrs #Hleft
+ cases (Hleft b' (bs'@〈grid,false〉::l1) b0 b0'
+ (b0s'@〈comma,false〉::l2) ??) -Hleft
+ [ 3: >Hrs normalize @eq_f >associative_append %
+ | * #Hb0 #Htapeb cases (IH …Htapeb) -IH * #_ #_ #IH
+ cases (IH b' b0' bs' b0s' (l1@[〈b0,false〉]) l2 ??????? Ha ?) -IH
+ [ * #Heq #Houtc % %
+ [ >Hb0 @eq_f >Hbs in Heq; >Hb0s in ⊢ (%→?); #Heq
+ destruct (Heq) >Hb0s >Hc >Hd %
+ | >Houtc >Hbs >Hb0s >Hc >Hd >reverse_cons >associative_append
+ >associative_append %
+ ]
+ | * #la * #c' * #d' * #lb * #lc * * * #H1 #H2 #H3 #H4 %2
+ @(ex_intro … (〈b,false〉::la)) @(ex_intro … c') @(ex_intro … d')
+ @(ex_intro … lb) @(ex_intro … lc)
+ % [ % [ % // >Hbs >Hc >H2 % | >Hb0s >Hd >H3 >Hb0 % ]
+ | >H4 >Hbs >Hb0s >Hc >Hd >Hb0 >reverse_append
+ >reverse_cons >reverse_cons
+ >associative_append >associative_append
+ >associative_append >associative_append %
+ ]
+ | generalize in match Hlen; >Hbs >Hb0s
+ normalize #Hlen destruct (Hlen) @e0
+ | #c0 #Hc0 @Hbs1 >Hbs @memb_cons //
+ | #c0 #Hc0 @Hb0s1 >Hb0s @memb_cons //
+ | #c0 #Hc0 @Hbs2 >Hbs @memb_cons //
+ | #c0 #Hc0 @Hb0s2 >Hb0s @memb_cons //
+ | #c0 #Hc0 cases (memb_append … Hc0)
+ [ @Hl1 | #Hc0' >(memb_single … Hc0') % ]
+ | %
+ | >associative_append >associative_append % ]
+ | * #Hneq #Htapeb %2
+ @(ex_intro … []) @(ex_intro … b) @(ex_intro … b0)
+ @(ex_intro … bs) @(ex_intro … b0s) %
+ [ % // % // @sym_not_eq //
+ | >Hbs >Hb0s >Hc >Hd >reverse_cons >associative_append
+ >reverse_append in Htapeb; >reverse_cons
+ >associative_append >associative_append
+ #Htapeb <Htapeb
+ cases (IH … Htapeb) -Htapeb -IH * #_ #IH #_ @(IH ? (refl ??))
+ ]
+ | #c1 #Hc1 cases (memb_append … Hc1) #Hyp
+ [ @Hbs2 >Hbs @memb_cons @Hyp
+ | cases (orb_true_l … Hyp)
+ [ #Hyp2 >(\P Hyp2) %
+ | @Hl1
+ ]
+ ]