X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=matita%2Fmatita%2Flib%2Fturing%2Fmono.ma;h=e89d710c948d2cf157d516e703f9c61ce76033d0;hb=690675dde36407d039e9d05047bc7909202170c1;hp=a9a08213b3e9fff6fe1794bf95a9b30ccd48f27d;hpb=1ed95da08b483c7f7e69fc645bee455572cad031;p=helm.git

diff --git a/matita/matita/lib/turing/mono.ma b/matita/matita/lib/turing/mono.ma
index a9a08213b..e89d710c9 100644
--- a/matita/matita/lib/turing/mono.ma
+++ b/matita/matita/lib/turing/mono.ma
@@ -12,14 +12,53 @@
 include "basics/vectors.ma".
 (* include "basics/relations.ma". *)
 
+(*
 record tape (sig:FinSet): Type[0] ≝ 
-{ left : list sig;
-  right: list sig
+{ left : list (option sig);
+  right: list (option sig)
 }.
+*)
+
+inductive tape (sig:FinSet) : Type[0] ≝ 
+| niltape : tape sig
+| leftof  : sig → list sig → tape sig
+| rightof : sig → list sig → tape sig
+| midtape : list sig → sig → list sig → tape sig.
+
+definition left ≝ 
+ λsig.λt:tape sig.match t with
+ [ niltape ⇒ [] 
+ | leftof _ _ ⇒ [] 
+ | rightof s l ⇒ s::l
+ | midtape l _ _ ⇒ l ].
+
+definition right ≝ 
+ λsig.λt:tape sig.match t with
+ [ niltape ⇒ [] 
+ | leftof s r ⇒ s::r 
+ | rightof _ _ ⇒ []
+ | midtape _ _ r ⇒ r ].
+ 
+ 
+definition current ≝ 
+ λsig.λt:tape sig.match t with
+ [ midtape _ c _ ⇒ Some ? c
+ | _ ⇒ None ? ].
+ 
+definition mk_tape : 
+  ∀sig:FinSet.list sig → option sig → list sig → tape sig ≝ 
+  λsig,lt,c,rt.match c with
+  [ Some c' ⇒ midtape sig lt c' rt
+  | None ⇒ match lt with 
+    [ nil ⇒ match rt with
+      [ nil ⇒ niltape ?
+      | cons r0 rs0 ⇒ leftof ? r0 rs0 ]
+    | cons l0 ls0 ⇒ rightof ? l0 ls0 ] ].
 
 inductive move : Type[0] ≝
 | L : move 
 | R : move
+| N : move
 .
 
 (* We do not distinuish an input tape *)
@@ -36,24 +75,78 @@ record config (sig,states:FinSet): Type[0] ≝
   ctape: tape sig
 }.
 
-definition option_hd ≝ λA.λl:list A.
+(* definition option_hd ≝ λA.λl:list (option A).
   match l with
   [nil ⇒ None ?
-  |cons a _ ⇒ Some ? a
+  |cons a _ ⇒ a
   ].
+  *)
 
-definition tape_move ≝ λsig.λt: tape sig.λm:option (sig × move).
-  match m with 
+(*definition tape_write ≝ λsig.λt:tape sig.λs:sig.
+  <left ? t) s (right ? t).
   [ None ⇒ t
-  | Some m1 ⇒ 
-    match \snd m1 with
-    [ R ⇒ mk_tape sig ((\fst m1)::(left ? t)) (tail ? (right ? t))
-    | L ⇒ mk_tape sig (tail ? (left ? t)) ((\fst m1)::(right ? t))
-    ]
-  ].
+  | Some s' ⇒ midtape ? (left ? t) s' (right ? t) ].*)
+  
+definition tape_move_left ≝ λsig:FinSet.λlt:list sig.λc:sig.λrt:list sig.
+  match lt with
+  [ nil ⇒ leftof sig c rt
+  | cons c0 lt0 ⇒ midtape sig lt0 c0 (c::rt) ].
+  
+definition tape_move_right ≝ λsig:FinSet.λlt:list sig.λc:sig.λrt:list sig.
+  match rt with
+  [ nil ⇒ rightof sig c lt
+  | cons c0 rt0 ⇒ midtape sig (c::lt) c0 rt0 ].
 
+definition tape_move ≝ λsig.λt: tape sig.λm:option (sig × move).
+  match m with
+  [ None ⇒ t
+  | Some m' ⇒ 
+    let 〈s,m1〉 ≝ m' in 
+    match m1 with
+      [ R ⇒ tape_move_right ? (left ? t) s (right ? t)
+      | L ⇒ tape_move_left ? (left ? t) s (right ? t)
+      | N ⇒ midtape ? (left ? t) s (right ? t)
+      ] ].
+(*
+  (None,[]) → □
+  (None,a::[]) → □
+  (None,a::b::rs) → None::b::rs
+  (Some a,[]) → [Some a]
+  (Some a,b::rs) → Some a::rs
+  *)
+(*
+definition option_cons ≝ λA.λa:option A.λl.
+  match a with
+  [ None ⇒ match l with
+    [ nil ⇒ []
+    | cons _ _ ⇒ a::l ]
+  | Some _ ⇒ a::l ].
+  
+(* definition tape_update := λsig.λt: tape sig.λs:option sig.
+  let newright ≝ 
+    match right ? t with
+    [ nil ⇒ match s with
+      [ None ⇒ [] 
+      | Some a ⇒ [Some ? a] ]
+    | cons b rs ⇒ match s with
+      [ None ⇒ match rs with
+        [ nil ⇒ [] 
+        | cons _ _ ⇒ None ?::rs ]
+      | Some a ⇒ Some ? a::rs ] ]
+  in mk_tape ? (left ? t) newright. *)
+  
+definition tape_move ≝ λsig.λt:tape sig.λm:option sig × move.
+  let 〈s,m1〉 ≝ m in match m1 with
+    [ R ⇒ mk_tape sig (option_cons ? s (left ? t)) (tail ? (right ? t))
+    | L ⇒ mk_tape sig (tail ? (left ? t)) 
+           (option_cons ? (option_hd ? (left ? t))
+             (option_cons ? s (tail ? (right ? t))))
+    | N ⇒ mk_tape sig (left ? t) (option_cons ? s (tail ? (right ? t)))
+    ].
+*)
+  
 definition step ≝ λsig.λM:TM sig.λc:config sig (states sig M).
-  let current_char ≝ option_hd ? (right ? (ctape ?? c)) in
+  let current_char ≝ current ? (ctape ?? c) in
   let 〈news,mv〉 ≝ trans sig M 〈cstate ?? c,current_char〉 in
   mk_config ?? news (tape_move sig (ctape ?? c) mv).
   
@@ -63,6 +156,18 @@ let rec loop (A:Type[0]) n (f:A→A) p a on n ≝
   | S m ⇒ if p a then (Some ? a) else loop A m f p (f a)
   ].
   
+lemma loop_S_true : 
+  ∀A,n,f,p,a.  p a = true → 
+  loop A (S n) f p a = Some ? a.
+#A #n #f #p #a #pa normalize >pa //
+qed.
+
+lemma loop_S_false : 
+  ∀A,n,f,p,a.  p a = false → 
+  loop A (S n) f p a = loop A n f p (f a).
+normalize #A #n #f #p #a #Hpa >Hpa %
+qed.  
+  
 lemma loop_incr : ∀A,f,p,k1,k2,a1,a2. 
   loop A k1 f p a1 = Some ? a2 → 
     loop A (k2+k1) f p a1 = Some ? a2.
@@ -73,7 +178,7 @@ lemma loop_incr : ∀A,f,p,k1,k2,a1,a2.
 ]
 qed.
 
-lemma loop_split : ∀A,f,p,q.(∀b. p b = false → q b = false) →
+lemma loop_merge : ∀A,f,p,q.(∀b. p b = false → q b = false) →
  ∀k1,k2,a1,a2,a3,a4.
    loop A k1 f p a1 = Some ? a2 → 
      f a2 = a3 → q a2 = false → 
@@ -92,6 +197,30 @@ lemma loop_split : ∀A,f,p,q.(∀b. p b = false → q b = false) →
  ]
 qed.
 
+lemma loop_split : ∀A,f,p,q.(∀b. q b = true → p b = true) →
+ ∀k,a1,a2.
+   loop A k f q a1 = Some ? a2 → 
+   ∃k1,a3.
+    loop A k1 f p a1 = Some ? a3 ∧ 
+      loop A (S(k-k1)) f q a3 = Some ? a2.
+#A #f #p #q #Hpq #k elim k
+  [#a1 #a2 normalize #Heq destruct
+  |#i #Hind #a1 #a2 normalize 
+   cases (true_or_false (q a1)) #Hqa1 >Hqa1 normalize
+    [ #Ha1a2 destruct
+     @(ex_intro … 1) @(ex_intro … a2) % 
+       [normalize >(Hpq …Hqa1) // |>Hqa1 //]
+    |#Hloop cases (true_or_false (p a1)) #Hpa1 
+       [@(ex_intro … 1) @(ex_intro … a1) % 
+         [normalize >Hpa1 // |>Hqa1 <Hloop normalize //]
+       |cases (Hind …Hloop) #k2 * #a3 * #Hloop1 #Hloop2
+        @(ex_intro … (S k2)) @(ex_intro … a3) %
+         [normalize >Hpa1 normalize // | @Hloop2 ]
+       ]
+    ]
+  ]
+qed.
+
 (*
 lemma loop_split : ∀A,f,p,q.(∀b. p b = false → q b = false) →
  ∀k1,k2,a1,a2,a3.
@@ -118,6 +247,36 @@ definition Realize ≝ λsig.λM:TM sig.λR:relation (tape sig).
   loop ? i (step sig M) (λc.halt sig M (cstate ?? c)) (initc sig M t) = Some ? outc ∧
   R t (ctape ?? outc).
 
+definition WRealize ≝ λsig.λM:TM sig.λR:relation (tape sig).
+∀t,i,outc.
+  loop ? i (step sig M) (λc.halt sig M (cstate ?? c)) (initc sig M t) = Some ? outc → 
+  R t (ctape ?? outc).
+
+definition Terminate ≝ λsig.λM:TM sig.λt. ∃i,outc.
+  loop ? i (step sig M) (λc.halt sig M (cstate ?? c)) (initc sig M t) = Some ? outc.
+
+lemma WRealize_to_Realize : ∀sig.∀M: TM sig.∀R.
+  (∀t.Terminate sig M t) → WRealize sig M R → Realize sig M R.
+#sig #M #R #HT #HW #t cases (HT … t) #i * #outc #Hloop 
+@(ex_intro … i) @(ex_intro … outc) % // @(HW … i) //
+qed.
+
+lemma loop_eq : ∀sig,f,q,i,j,a,x,y. 
+  loop sig i f q a = Some ? x → loop sig j f q a = Some ? y → x = y.
+#sig #f #q #i #j @(nat_elim2 … i j)
+[ #n #a #x #y normalize #Hfalse destruct (Hfalse)
+| #n #a #x #y #H1 normalize #Hfalse destruct (Hfalse)
+| #n1 #n2 #IH #a #x #y normalize cases (q a) normalize
+  [ #H1 #H2 destruct %
+  | /2/ ]
+]
+qed.
+
+theorem Realize_to_WRealize : ∀sig,M,R.Realize sig M R → WRealize sig M R.
+#sig #M #R #H1 #inc #i #outc #Hloop
+cases (H1 inc) #k * #outc1 * #Hloop1 #HR
+>(loop_eq … Hloop Hloop1) //
+qed.
 
 definition accRealize ≝ λsig.λM:TM sig.λacc:states sig M.λRtrue,Rfalse:relation (tape sig).
 ∀t.∃i.∃outc.
@@ -125,6 +284,25 @@ definition accRealize ≝ λsig.λM:TM sig.λacc:states sig M.λRtrue,Rfalse:rel
   (cstate ?? outc = acc → Rtrue t (ctape ?? outc)) ∧ 
   (cstate ?? outc ≠ acc → Rfalse t (ctape ?? outc)).
 
+(* NO OPERATION
+
+  t1 = t2
+  *)
+  
+definition nop_states ≝ initN 1.
+
+definition nop ≝ 
+  λalpha:FinSet.mk_TM alpha nop_states
+  (λp.let 〈q,a〉 ≝ p in 〈q,None ?〉)
+  O (λ_.true).
+  
+definition R_nop ≝ λalpha.λt1,t2:tape alpha.t2 = t1.
+
+lemma sem_nop :
+  ∀alpha.Realize alpha (nop alpha) (R_nop alpha).
+#alpha #intape @(ex_intro ?? 1) @ex_intro [| % normalize % ]
+qed.
+
 (* Compositions *)
 
 definition seq_trans ≝ λsig. λM1,M2 : TM sig. 
@@ -228,30 +406,34 @@ lemma step_lift_confR : ∀sig,M1,M2,c0.
  halt ? M2 (cstate ?? c0) = false → 
  step sig (seq sig M1 M2) (lift_confR sig (states ? M1) (states ? M2) c0) =
  lift_confR sig (states ? M1) (states ? M2) (step sig M2 c0).
-#sig #M1 (* * #Q1 #T1 #init1 #halt1 *) #M2 * #s * #lt
-#rs #Hhalt
-whd in ⊢ (???(????%));whd in ⊢ (???%);
-lapply (refl ? (trans ?? 〈s,option_hd sig rs〉))
-cases (trans ?? 〈s,option_hd sig rs〉) in ⊢ (???% → %);
-#s0 #m0 #Heq whd in ⊢ (???%);
-whd in ⊢ (??(???%)?); whd in ⊢ (??%?);
->(trans_liftR … Heq)
-[% | //]
+#sig #M1 (* * #Q1 #T1 #init1 #halt1 *) #M2 * #s #t
+  lapply (refl ? (trans ?? 〈s,current sig t〉))
+  cases (trans ?? 〈s,current sig t〉) in ⊢ (???% → %);
+  #s0 #m0 cases t
+  [ #Heq #Hhalt
+  | 2,3: #s1 #l1 #Heq #Hhalt 
+  |#ls #s1 #rs #Heq #Hhalt ]
+  whd in ⊢ (???(????%)); >Heq
+  whd in ⊢ (???%);
+  whd in ⊢ (??(???%)?); whd in ⊢ (??%?);
+  >(trans_liftR … Heq) //
 qed.
 
 lemma step_lift_confL : ∀sig,M1,M2,c0.
  halt ? M1 (cstate ?? c0) = false → 
  step sig (seq sig M1 M2) (lift_confL sig (states ? M1) (states ? M2) c0) =
  lift_confL sig ?? (step sig M1 c0).
-#sig #M1 (* * #Q1 #T1 #init1 #halt1 *) #M2 * #s * #lt
-#rs #Hhalt
-whd in ⊢ (???(????%));whd in ⊢ (???%);
-lapply (refl ? (trans ?? 〈s,option_hd sig rs〉))
-cases (trans ?? 〈s,option_hd sig rs〉) in ⊢ (???% → %);
-#s0 #m0 #Heq whd in ⊢ (???%);
-whd in ⊢ (??(???%)?); whd in ⊢ (??%?);
->(trans_liftL … Heq)
-[% | //]
+#sig #M1 (* * #Q1 #T1 #init1 #halt1 *) #M2 * #s #t
+  lapply (refl ? (trans ?? 〈s,current sig t〉))
+  cases (trans ?? 〈s,current sig t〉) in ⊢ (???% → %);
+  #s0 #m0 cases t
+  [ #Heq #Hhalt
+  | 2,3: #s1 #l1 #Heq #Hhalt 
+  |#ls #s1 #rs #Heq #Hhalt ]
+  whd in ⊢ (???(????%)); >Heq
+  whd in ⊢ (???%);
+  whd in ⊢ (??(???%)?); whd in ⊢ (??%?);
+  >(trans_liftL … Heq) //
 qed.
 
 lemma loop_lift : ∀A,B,k,lift,f,g,h,hlift,c1,c2.
@@ -346,7 +528,7 @@ cases (HR1 t) #k1 * #outc1 * #Hloop1 #HM1
 cases (HR2 (ctape sig (states ? M1) outc1)) #k2 * #outc2 * #Hloop2 #HM2
 @(ex_intro … (k1+k2)) @(ex_intro … (lift_confR … outc2))
 %
-[@(loop_split ??????????? 
+[@(loop_merge ??????????? 
    (loop_lift ??? (lift_confL sig (states sig M1) (states sig M2))
    (step sig M1) (step sig (seq sig M1 M2)) 
    (λc.halt sig M1 (cstate … c))