X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fmatita%2Flib%2Fturing%2Funiversal%2Fmarks.ma;h=829f56dc57ea7c1a2f80eef71df3a2d60a399ce4;hb=31cb2f0b374657eb5acb95708443e2c1b8481891;hp=8a61516ac168c67b2045175ff75e1bbe9f5670c2;hpb=3fc94a73952678239bed11c605e180163f924c10;p=helm.git

diff --git a/matita/matita/lib/turing/universal/marks.ma b/matita/matita/lib/turing/universal/marks.ma
index 8a61516ac..829f56dc5 100644
--- a/matita/matita/lib/turing/universal/marks.ma
+++ b/matita/matita/lib/turing/universal/marks.ma
@@ -14,9 +14,9 @@
 
 *)
 
-include "turing/while_machine.ma".
 include "turing/if_machine.ma".
-include "turing/universal/tests.ma".
+include "turing/basic_machines.ma".
+include "turing/universal/alphabet.ma".
 
 (* ADVANCE TO MARK (right)
 
@@ -29,17 +29,21 @@ include "turing/universal/tests.ma".
 
 definition atm_states ≝ initN 3.
 
+definition atm0 : atm_states ≝ mk_Sig ?? 0 (leb_true_to_le 1 3 (refl …)).
+definition atm1 : atm_states ≝ mk_Sig ?? 1 (leb_true_to_le 2 3 (refl …)).
+definition atm2 : atm_states ≝ mk_Sig ?? 2 (leb_true_to_le 3 3 (refl …)).
+
 definition atmr_step ≝ 
   λalpha:FinSet.λtest:alpha→bool.
   mk_TM alpha atm_states
   (λp.let 〈q,a〉 ≝ p in
    match a with
-   [ None ⇒ 〈1, None ?〉
+   [ None ⇒ 〈atm1, None ?〉
    | Some a' ⇒ 
      match test a' with
-     [ true ⇒ 〈1,None ?〉
-     | false ⇒ 〈2,Some ? 〈a',R〉〉 ]])
-  O (λx.notb (x == 0)).
+     [ true ⇒ 〈atm1,None ?〉
+     | false ⇒ 〈atm2,Some ? 〈a',R〉〉 ]])
+  atm0 (λx.notb (x == atm0)).
 
 definition Ratmr_step_true ≝ 
   λalpha,test,t1,t2.
@@ -56,43 +60,45 @@ definition Ratmr_step_false ≝
 lemma atmr_q0_q1 :
   ∀alpha,test,ls,a0,rs. test a0 = true → 
   step alpha (atmr_step alpha test)
-    (mk_config ?? 0 (midtape … ls a0 rs)) =
-  mk_config alpha (states ? (atmr_step alpha test)) 1
+    (mk_config ?? atm0 (midtape … ls a0 rs)) =
+  mk_config alpha (states ? (atmr_step alpha test)) atm1
     (midtape … ls a0 rs).
-#alpha #test #ls #a0 #ts #Htest normalize >Htest %
+#alpha #test #ls #a0 #ts #Htest whd in ⊢ (??%?);
+whd in match (trans … 〈?,?〉); >Htest %
 qed.
      
 lemma atmr_q0_q2 :
   ∀alpha,test,ls,a0,rs. test a0 = false → 
   step alpha (atmr_step alpha test)
-    (mk_config ?? 0 (midtape … ls a0 rs)) =
-  mk_config alpha (states ? (atmr_step alpha test)) 2
+    (mk_config ?? atm0 (midtape … ls a0 rs)) =
+  mk_config alpha (states ? (atmr_step alpha test)) atm2
     (mk_tape … (a0::ls) (option_hd ? rs) (tail ? rs)).
-#alpha #test #ls #a0 #ts #Htest normalize >Htest cases ts //
+#alpha #test #ls #a0 #ts #Htest whd in ⊢ (??%?);
+whd in match (trans … 〈?,?〉); >Htest cases ts //
 qed.
 
 lemma sem_atmr_step :
   ∀alpha,test.
   accRealize alpha (atmr_step alpha test) 
-    2 (Ratmr_step_true alpha test) (Ratmr_step_false alpha test).
+    atm2 (Ratmr_step_true alpha test) (Ratmr_step_false alpha test).
 #alpha #test *
 [ @(ex_intro ?? 2)
-  @(ex_intro ?? (mk_config ?? 1 (niltape ?))) %
-  [ % // #Hfalse destruct | #_ % // % % ]
-| #a #al @(ex_intro ?? 2) @(ex_intro ?? (mk_config ?? 1 (leftof ? a al)))
-  % [ % // #Hfalse destruct | #_ % // % % ]
-| #a #al @(ex_intro ?? 2) @(ex_intro ?? (mk_config ?? 1 (rightof ? a al)))
-  % [ % // #Hfalse destruct | #_ % // % % ]
+  @(ex_intro ?? (mk_config ?? atm1 (niltape ?))) %
+  [ % // whd in ⊢ ((??%%)→?); #Hfalse destruct | #_ % // % % ]
+| #a #al @(ex_intro ?? 2) @(ex_intro ?? (mk_config ?? atm1 (leftof ? a al)))
+  % [ % // whd in ⊢ ((??%%)→?); #Hfalse destruct | #_ % // % % ]
+| #a #al @(ex_intro ?? 2) @(ex_intro ?? (mk_config ?? atm1 (rightof ? a al)))
+  % [ % // whd in ⊢ ((??%%)→?); #Hfalse destruct | #_ % // % % ]
 | #ls #c #rs @(ex_intro ?? 2)
   cases (true_or_false (test c)) #Htest
-  [ @(ex_intro ?? (mk_config ?? 1 ?))
+  [ @(ex_intro ?? (mk_config ?? atm1 ?))
     [| % 
       [ % 
         [ whd in ⊢ (??%?); >atmr_q0_q1 //
-        | #Hfalse destruct ]
+        | whd in ⊢ ((??%%)→?); #Hfalse destruct ]
       | #_ % // %2 @(ex_intro ?? c) % // ]
     ]
-  | @(ex_intro ?? (mk_config ?? 2 (mk_tape ? (c::ls) (option_hd ? rs) (tail ? rs))))
+  | @(ex_intro ?? (mk_config ?? atm2 (mk_tape ? (c::ls) (option_hd ? rs) (tail ? rs))))
     % 
     [ %
       [ whd in ⊢ (??%?); >atmr_q0_q2 //
@@ -115,7 +121,7 @@ definition R_adv_to_mark_r ≝ λalpha,test,t1,t2.
      t2 = midtape ? (reverse ? rs1@c::ls) b rs2))).
      
 definition adv_to_mark_r ≝ 
-  λalpha,test.whileTM alpha (atmr_step alpha test) 2.
+  λalpha,test.whileTM alpha (atmr_step alpha test) atm2.
 
 lemma wsem_adv_to_mark_r :
   ∀alpha,test.
@@ -187,15 +193,18 @@ qed.
  
 definition mark_states ≝ initN 2.
 
+definition ms0 : mark_states ≝ mk_Sig ?? 0 (leb_true_to_le 1 2 (refl …)).
+definition ms1 : mark_states ≝ mk_Sig ?? 1 (leb_true_to_le 2 2 (refl …)).
+
 definition mark ≝ 
   λalpha:FinSet.mk_TM (FinProd … alpha FinBool) mark_states
   (λp.let 〈q,a〉 ≝ p in
     match a with
-    [ None ⇒ 〈1,None ?〉
-    | Some a' ⇒ match q with
-      [ O ⇒ let 〈a'',b〉 ≝ a' in 〈1,Some ? 〈〈a'',true〉,N〉〉
-      | S q ⇒ 〈1,None ?〉 ] ])
-  O (λq.q == 1).
+    [ None ⇒ 〈ms1,None ?〉
+    | Some a' ⇒ match (pi1 … q) with
+      [ O ⇒ let 〈a'',b〉 ≝ a' in 〈ms1,Some ? 〈〈a'',true〉,N〉〉
+      | S q ⇒ 〈ms1,None ?〉 ] ])
+  ms0 (λq.q == ms1).
   
 definition R_mark ≝ λalpha,t1,t2.
   ∀ls,c,b,rs.
@@ -215,77 +224,6 @@ lemma sem_mark :
   @ex_intro [| % [ % | #ls0 #c0 #b0 #rs0 #H1 destruct (H1) % ] ] ]
 qed.
 
-(* MOVE RIGHT 
-
-   moves the head one step to the right
-
-*)
-
-definition move_states ≝ initN 2.
-
-definition move_r ≝ 
-  λalpha:FinSet.mk_TM alpha move_states
-  (λp.let 〈q,a〉 ≝ p in
-    match a with
-    [ None ⇒ 〈1,None ?〉
-    | Some a' ⇒ match q with
-      [ O ⇒ 〈1,Some ? 〈a',R〉〉
-      | S q ⇒ 〈1,None ?〉 ] ])
-  O (λq.q == 1).
-  
-definition R_move_r ≝ λalpha,t1,t2.
-  ∀ls,c,rs.
-  t1 = midtape alpha ls c rs → 
-  t2 = mk_tape ? (c::ls) (option_hd ? rs) (tail ? rs).
-    
-lemma sem_move_r :
-  ∀alpha.Realize ? (move_r alpha) (R_move_r alpha).
-#alpha #intape @(ex_intro ?? 2) cases intape
-[ @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-|#a #al @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-|#a #al @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-| #ls #c #rs
-  @ex_intro [| % [ % | #ls0 #c0 #rs0 #H1 destruct (H1)
-  cases rs0 // ] ] ]
-qed.
-
-(* MOVE LEFT
-
-   moves the head one step to the right
-
-*)
-
-definition move_l ≝ 
-  λalpha:FinSet.mk_TM alpha move_states
-  (λp.let 〈q,a〉 ≝ p in
-    match a with
-    [ None ⇒ 〈1,None ?〉
-    | Some a' ⇒ match q with
-      [ O ⇒ 〈1,Some ? 〈a',L〉〉
-      | S q ⇒ 〈1,None ?〉 ] ])
-  O (λq.q == 1).
-  
-definition R_move_l ≝ λalpha,t1,t2.
-  ∀ls,c,rs.
-  t1 = midtape alpha ls c rs → 
-  t2 = mk_tape ? (tail ? ls) (option_hd ? ls) (c::rs).
-    
-lemma sem_move_l :
-  ∀alpha.Realize ? (move_l alpha) (R_move_l alpha).
-#alpha #intape @(ex_intro ?? 2) cases intape
-[ @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-|#a #al @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-|#a #al @ex_intro
-  [| % [ % | #ls #c #rs #Hfalse destruct ] ]
-| #ls #c #rs
-  @ex_intro [| % [ % | #ls0 #c0 #rs0 #H1 destruct (H1)
-  cases ls0 // ] ] ]
-qed.
 
 (* MOVE RIGHT AND MARK machine
 
@@ -296,18 +234,22 @@ qed.
  
 definition mrm_states ≝ initN 3.
 
+definition mrm0 : mrm_states ≝ mk_Sig ?? 0 (leb_true_to_le 1 3 (refl …)).
+definition mrm1 : mrm_states ≝ mk_Sig ?? 1 (leb_true_to_le 2 3 (refl …)).
+definition mrm2 : mrm_states ≝ mk_Sig ?? 2 (leb_true_to_le 3 3 (refl …)).
+
 definition move_right_and_mark ≝ 
   λalpha:FinSet.mk_TM (FinProd … alpha FinBool) mrm_states
   (λp.let 〈q,a〉 ≝ p in
     match a with
-    [ None ⇒ 〈2,None ?〉
-    | Some a' ⇒ match q with
-      [ O ⇒ 〈1,Some ? 〈a',R〉〉
+    [ None ⇒ 〈mrm2,None ?〉
+    | Some a' ⇒ match pi1 … q with
+      [ O ⇒ 〈mrm1,Some ? 〈a',R〉〉
       | S q ⇒ match q with
         [ O ⇒ let 〈a'',b〉 ≝ a' in
-              〈2,Some ? 〈〈a'',true〉,N〉〉
-        | S _ ⇒ 〈2,None ?〉 ] ] ])
-  O (λq.q == 2).
+              〈mrm2,Some ? 〈〈a'',true〉,N〉〉
+        | S _ ⇒ 〈mrm2,None ?〉 ] ] ])
+  mrm0 (λq.q == mrm2).
   
 definition R_move_right_and_mark ≝ λalpha,t1,t2.
   ∀ls,c,d,b,rs.
@@ -336,15 +278,19 @@ qed.
  
 definition clear_mark_states ≝ initN 3.
 
+definition clear0 : clear_mark_states ≝ mk_Sig ?? 0 (leb_true_to_le 1 3 (refl …)).
+definition clear1 : clear_mark_states ≝ mk_Sig ?? 1 (leb_true_to_le 2 3 (refl …)).
+definition claer2 : clear_mark_states ≝ mk_Sig ?? 2 (leb_true_to_le 3 3 (refl …)).
+
 definition clear_mark ≝ 
   λalpha:FinSet.mk_TM (FinProd … alpha FinBool) clear_mark_states
   (λp.let 〈q,a〉 ≝ p in
     match a with
-    [ None ⇒ 〈1,None ?〉
-    | Some a' ⇒ match q with
-      [ O ⇒ let 〈a'',b〉 ≝ a' in 〈1,Some ? 〈〈a'',false〉,N〉〉
-      | S q ⇒ 〈1,None ?〉 ] ])
-  O (λq.q == 1).
+    [ None ⇒ 〈clear1,None ?〉
+    | Some a' ⇒ match pi1 … q with
+      [ O ⇒ let 〈a'',b〉 ≝ a' in 〈clear1,Some ? 〈〈a'',false〉,N〉〉
+      | S q ⇒ 〈clear1,None ?〉 ] ])
+  clear0 (λq.q == clear1).
   
 definition R_clear_mark ≝ λalpha,t1,t2.
   ∀ls,c,b,rs.
@@ -497,10 +443,6 @@ qed.
         ^
 *)
 
-definition is_marked ≝ 
-  λalpha.λp:FinProd … alpha FinBool.
-  let 〈x,b〉 ≝ p in b.
-
 definition adv_both_marks ≝ 
   λalpha.seq ? (adv_mark_r alpha)
     (seq ? (move_l ?)
@@ -542,30 +484,6 @@ cases (sem_seq ????? (sem_adv_mark_r …)
     | >reverse_append #Htc @Htc ]
   ]
 qed.
-  
-inductive unialpha : Type[0] ≝ 
-| bit : bool → unialpha
-| comma : unialpha
-| bar : unialpha
-| grid : unialpha.
-
-definition unialpha_eq ≝ 
-  λa1,a2.match a1 with
-  [ bit x ⇒ match a2 with [ bit y ⇒ ¬ xorb x y | _ ⇒ false ]
-  | comma ⇒ match a2 with [ comma ⇒ true | _ ⇒ false ]
-  | bar ⇒ match a2 with [ bar ⇒ true | _ ⇒ false ]
-  | grid ⇒ match a2 with [ grid ⇒ true | _ ⇒ false ] ].
-  
-definition DeqUnialpha ≝ mk_DeqSet unialpha unialpha_eq ?.
-* [ #x * [ #y cases x cases y normalize % // #Hfalse destruct
-         | *: normalize % #Hfalse destruct ]
-  |*: * [1,5,9,13: #y ] normalize % #H1 destruct % ]
-qed.
-
-definition FSUnialpha ≝ 
-  mk_FinSet DeqUnialpha [bit true;bit false;comma;bar;grid] ?.
-@daemon
-qed.
 
 (* 
    MATCH AND ADVANCE(f)
@@ -673,7 +591,7 @@ cases (sem_if ? (test_char ? (λx.x == c)) … tc_true
     | * #Hx0 #Houtc %2
       % [ <(\P Hx) in Hx0; #Hx0 lapply (\Pf Hx0) @not_to_not #Hx' >Hx' %
         | >Houtc % ]
-    | (* members of lists are invariant under reverse *) @daemon ]
+    | #x #membx @Hl1 <(reverse_reverse …l1) @memb_reverse @membx ]
   | %2 % [ @(\Pf Hc) ]
     >Hintape in Hta; #Hta cases (Hta ? (refl ??)) -Hta #Hx #Hta
     >Hx in Hc;#Hc destruct (Hc) ]
@@ -701,17 +619,16 @@ definition comp_step ≝
   ifTM ? (test_char ? (is_marked ?))
   (single_finalTM … (comp_step_subcase FSUnialpha 〈bit false,true〉
     (comp_step_subcase FSUnialpha 〈bit true,true〉
-      (clear_mark …))))
+      (comp_step_subcase FSUnialpha 〈null,true〉
+        (clear_mark …)))))
   (nop ?)
   tc_true.
   
-definition is_bit ≝ λc.match c with [ bit _ ⇒ true | _ ⇒ false ].
-  
 definition R_comp_step_true ≝ 
   λt1,t2.
     ∀l0,c,rs.t1 = midtape (FinProd … FSUnialpha FinBool) l0 c rs → 
     ∃c'. c = 〈c',true〉 ∧
-    ((is_bit c' = true ∧
+    ((bit_or_null c' = true ∧
      ∀a,l1,c0,a0,l2.
       rs = 〈a,false〉::l1@〈c0,true〉::〈a0,false〉::l2 → 
       (∀c.memb ? c l1 = true → is_marked ? c = false) → 
@@ -720,7 +637,7 @@ definition R_comp_step_true ≝
       (c0 ≠ c' ∧
        t2 = midtape (FinProd … FSUnialpha FinBool) 
         (reverse ? l1@〈a,false〉::〈c',true〉::l0) 〈c0,false〉 (〈a0,false〉::l2))) ∨
-     (is_bit c' = false ∧ t2 = midtape ? l0 〈c',false〉 rs)).
+     (bit_or_null c' = false ∧ t2 = midtape ? l0 〈c',false〉 rs)).
 
 definition R_comp_step_false ≝ 
   λt1,t2.
@@ -728,13 +645,14 @@ definition R_comp_step_false ≝
    is_marked ? c = false ∧ t2 = t1.
    
 lemma sem_comp_step : 
-  accRealize ? comp_step (inr … (inl … (inr … 0))) 
+  accRealize ? comp_step (inr … (inl … (inr … start_nop))) 
     R_comp_step_true R_comp_step_false.
 #intape
 cases (acc_sem_if … (sem_test_char ? (is_marked ?))
         (sem_comp_step_subcase FSUnialpha 〈bit false,true〉 ??
           (sem_comp_step_subcase FSUnialpha 〈bit true,true〉 ?? 
-            (sem_clear_mark …)))
+            (sem_comp_step_subcase FSUnialpha 〈null,true〉 ?? 
+              (sem_clear_mark …))))
         (sem_nop …) intape)
 #k * #outc * * #Hloop #H1 #H2
 @(ex_intro ?? k) @(ex_intro ?? outc) %
@@ -762,13 +680,24 @@ cases (acc_sem_if … (sem_test_char ? (is_marked ?))
         [ @sym_not_eq //
         | @Houtc ]
       ]
-    | * #Hc' whd in ⊢ (%→?); #Helse2 %2 %
-      [ generalize in match Hc'; generalize in match Hc;
-        cases c'
-        [ * [ #_ #Hfalse @False_ind @(absurd ?? Hfalse) %
-            | #Hfalse @False_ind @(absurd ?? Hfalse) % ]
-        |*: #_ #_ % ]
-      | @(Helse2 … Hta)
+    | * #Hc' #Helse2 cases (Helse2 … Hta)
+      [ * #Hc'' #H1 % % [destruct (Hc'') % ]
+        #a #l1 #c0 #a0 #l2 #Hrs >Hrs in Hintape; #Hintape #Hl1
+        cases (H1 … Hl1 Hrs)
+        [ * #Htmp >Htmp -Htmp #Houtc % % // @Houtc
+        | * #Hneq #Houtc %2 %
+          [ @sym_not_eq //
+          | @Houtc ]
+        ]
+      | * #Hc'' whd in ⊢ (%→?); #Helse3 %2 %
+        [ generalize in match Hc''; generalize in match Hc'; generalize in match Hc;
+          cases c'
+          [ * [ #_ #Hfalse @False_ind @(absurd ?? Hfalse) %
+              | #Hfalse @False_ind @(absurd ?? Hfalse) % ]
+          | #_ #_ #Hfalse @False_ind @(absurd ?? Hfalse) %
+          |*: #_ #_ #_ % ]
+        | @(Helse3 … Hta)
+        ]
       ]
     ]
   ]
@@ -781,7 +710,7 @@ cases (acc_sem_if … (sem_test_char ? (is_marked ?))
 qed.
 
 definition compare ≝ 
-  whileTM ? comp_step (inr … (inl … (inr … 0))).
+  whileTM ? comp_step (inr … (inl … (inr … start_nop))).
 
 (*
 definition R_compare :=
@@ -832,21 +761,20 @@ RIFIUTO: c ≠ d
 definition R_compare :=
   λt1,t2.
   ∀ls,c,rs.t1 = midtape (FinProd … FSUnialpha FinBool) ls c rs → 
-  (∀c'.is_bit c' = false → c = 〈c',true〉 → t2 = midtape ? ls 〈c',false〉 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 → is_bit (\fst c) = true) → 
-  (∀c.memb (FinProd … FSUnialpha FinBool) c b0s = true → is_bit (\fst c) = true) → 
+  (∀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〉 → is_bit b = true → 
+  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 ∧
-   ∀l3,c.〈b0,false〉::b0s = l3@[〈c,false〉] → 
    t2 = midtape ? (reverse ? bs@〈b,false〉::ls)
-          〈grid,false〉 (l1@l3@〈c,true〉::〈comma,false〉::l2)) ∨
+          〈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 ∧
@@ -858,213 +786,117 @@ definition R_compare :=
                     reverse ? la@ls)
                     〈d',false〉 (lc@〈comma,false〉::l2)).
                     
-lemma list_ind2 : 
-  ∀T1,T2:Type[0].∀l1:list T1.∀l2:list T2.∀P:list T1 → list T2 → Prop.
-  length ? l1 = length ? l2 →
-  (P [] []) → 
-  (∀tl1,tl2,hd1,hd2. P tl1 tl2 → P (hd1::tl1) (hd2::tl2)) → 
-  P l1 l2.
-#T1 #T2 #l1 #l2 #P #Hl #Pnil #Pcons
-generalize in match Hl; generalize in match l2;
-elim l1
-[#l2 cases l2 // normalize #t2 #tl2 #H destruct
-|#t1 #tl1 #IH #l2 cases l2
-   [normalize #H destruct
-   |#t2 #tl2 #H @Pcons @IH normalize in H; destruct // ]
-]
-qed.
-
-lemma list_cases_2 : 
-  ∀T1,T2:Type[0].∀l1:list T1.∀l2:list T2.∀P:Prop.
-  length ? l1 = length ? l2 →
-  (l1 = [] → l2 = [] → P) → 
-  (∀hd1,hd2,tl1,tl2.l1 = hd1::tl1 → l2 = hd2::tl2 → P) → P.
-#T1 #T2 #l1 #l2 #P #Hl @(list_ind2 … Hl)
-[ #Pnil #Pcons @Pnil //
-| #tl1 #tl2 #hd1 #hd2 #IH1 #IH2 #Hp @Hp // ]
-qed.
-
 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 ⊢ (%→?); #Hsem #ls #c #rs #Htapea %
+[ #tapea whd in ⊢ (%→?); #Rfalse #ls #c #rs #Htapea %
   [ %
-    [ #c' #Hc' #Hc lapply (Hsem … Htapea) -Hsem * >Hc
+    [ #c' #Hc' #Hc lapply (Rfalse … Htapea) -Rfalse * >Hc
       whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
-    | #c' #Hc lapply (Hsem … Htapea) -Hsem * #_
+    | #c' #Hc lapply (Rfalse … Htapea) -Rfalse * #_
       #Htrue @Htrue ]
   | #b #b0 #bs #b0s #l1 #l2 #Hlen #Hbs1 #Hb0s1 #Hbs2 #Hb0s2 #Hl1 #Hc
-    cases (Hsem … Htapea) -Hsem >Hc whd in ⊢ (??%?→?);#Hfalse destruct (Hfalse)
+    cases (Rfalse … Htapea) -Rfalse >Hc whd in ⊢ (??%?→?);#Hfalse destruct (Hfalse)
   ]
-| #tapea #tapeb #tapec #Hleft #Hright #IH #Htapec lapply (IH Htapec) -IH #IH
+| #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 destruct (Hc) cases (true_or_false (c' == grid)) #Hc'
-  [ #Hleft %
-    [ %
-      [ #c'' #Hc'' #Heq destruct (Heq) whd in IH; cases Hleft
-        [ * >Hc'' whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
-        | * #_ #Htapeb cases (IH … Htapeb) -IH * #_ #IH #_ >IH
-          [ <(\P Hc') @Htapeb
-          | %
-          |]
+  #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)
         ]
-      | #c0 #Hfalse destruct (Hfalse)
+      |#b #b0 #bs #b0s #l1 #l2 #_ #_ #_ #_ #_ #_
+       #Heq destruct (Heq) >Hc' #Hfalse @False_ind destruct (Hfalse)
       ]
-    |#b #b0 #bs #b0s #l1 #l2 #Hlen #Hbs1 #Hb0s1 #Hbs2 #Hb0s2 #Hl1
-     #Heq destruct (Heq) >(\P Hc') whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
     ]
-  | #Hleft %
+ |#Hleft %
     [ %
-      [ #c'' #Hc'' #Heq destruct (Heq) whd in IH; cases Hleft
-        [ * >Hc'' whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
-        | * #_ #Htapeb cases (IH … Htapeb) -IH * #_ #IH #_ >IH
-          [ @Htapeb
-          | %
-          |]
-        ]
+      [ #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 whd in IH; destruct (Heq) #H1 #Hrs cases Hleft -Hleft
-     [| * >H1 #Hfalse destruct (Hfalse) ]
-     * #_ #Hleft @(list_cases_2 … Hlen)
-     [ #Hbs #Hb0s generalize in match Hrs; >Hbs in ⊢ (%→?); >Hb0s in ⊢ (%→?);
-       -Hrs #Hrs normalize in Hrs; 
-       cases (Hleft ????? Hrs ?)
-       [ * #Heqb #Htapeb cases (IH … Htapeb) -IH * #IH #_ #_
-        % %
-        [ >Heqb >Hbs >Hb0s %
-        | #l3 #c0 #Hyp >Hbs >Hb0s 
-         cases (IH b b0 bs l1 l2 Hlen ?????
-     
-     >(\P Hc') whd in ⊢ (??%?→?); #Hfalse destruct (Hfalse)
-    ]
-qed.
-                   
-
-
-(*
-l0 x* a l1 x0* a0 l2 ------> l0 x a* l1 x0 a0* l2
-   ^                               ^
-
-if current (* x *) = #
-   then 
-   else if x = 0
-      then move_right; ----
-           adv_to_mark_r;
-           if current (* x0 *) = 0
-              then advance_mark ----
-                   adv_to_mark_l;
-                   advance_mark
-              else STOP
-      else x = 1 (* analogo *)
-
-*)
-
-
-(*
-   MARK NEXT TUPLE machine
-   (partially axiomatized)
-   
-   marks the first character after the first bar (rightwards)
- *)
-
-axiom myalpha : FinSet.
-axiom is_bar : FinProd … myalpha FinBool → bool.
-axiom is_grid : FinProd … myalpha FinBool → bool.
-definition bar_or_grid ≝ λc.is_bar c ∨ is_grid c.
-axiom bar : FinProd … myalpha FinBool.
-axiom grid : FinProd … myalpha FinBool.
-
-definition mark_next_tuple ≝ 
-  seq ? (adv_to_mark_r ? bar_or_grid)
-     (ifTM ? (test_char ? is_bar)
-       (move_r_and_mark ?) (nop ?) 1).
-
-definition R_mark_next_tuple ≝ 
-  λt1,t2.
-    ∀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 % ]
+     #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
+             ]
+           ]
          ]
-       ]
-    | * #rs3 * #c0 * #rs4 * * #Hc0 #Hsplit #Hrs3
-      % @(ex_intro ?? rs3) @(ex_intro ?? rs4)
-     lapply (Hta rs3 c0 (rs4@grid::rs2) ???)
-     [ #x #Hrs3' (* Hrs1, Hrs3, Hsplit *) @daemon
-     | (* bar → bar_or_grid *) @daemon
-     | >Hsplit >associative_append % ] -Hta #Hta
-       cases Hright
-       [ * #tb * whd in ⊢ (%→?); #Hta'
-         whd in ⊢ (%→?); #Htb
-         cases (Hta' c0 ?)
-         [ #_ #Htb' >Htb' in Htb; #Htb
-           generalize in match Hsplit; -Hsplit
-           cases rs4 in Hta;
-           [ >(eq_pair_fst_snd … grid)
-             #Hta #Hsplit >(Htb … Hta)
-             >(?:c0 = bar)
-             [ @(ex_intro ?? (\fst grid)) @(ex_intro ?? (\snd grid))
-               % [ % [ % [ (* Hsplit *) @daemon |(*Hrs3*) @daemon ] | % ] | % ] 
-                     | (* Hc0 *) @daemon ]
-           | #r5 #rs5 >(eq_pair_fst_snd … r5)
-             #Hta #Hsplit >(Htb … Hta)
-             >(?:c0 = bar)
-             [ @(ex_intro ?? (\fst r5)) @(ex_intro ?? (\snd r5))
-               % [ % [ % [ (* Hc0, Hsplit *) @daemon | (*Hrs3*) @daemon ] | % ]
-                     | % ] | (* Hc0 *) @daemon ] ] | >Hta % ]
-             | * #tb * whd in ⊢ (%→?); #Hta'
-               whd in ⊢ (%→?); #Htb
-               cases (Hta' c0 ?)
-               [ #Hfalse @False_ind >Hfalse in Hc0;
-                 #Hc0 destruct (Hc0)
-               | >Hta % ]
-]]]]
-qed.
\ No newline at end of file
+]]]]]
+qed.       
+
+axiom sem_compare : Realize ? compare R_compare.
\ No newline at end of file