From b2e4273cdfa45add6110a81626dcb3e25928a0d4 Mon Sep 17 00:00:00 2001
From: Andrea Asperti <andrea.asperti@unibo.it>
Date: Fri, 18 Jan 2013 10:32:00 +0000
Subject: [PATCH] semantics of uni_step

---
 .../lib/turing/multi_universal/alphabet.ma    |  5 ++
 .../lib/turing/multi_universal/unistep_aux.ma | 59 +++++++++++++++++--
 2 files changed, 60 insertions(+), 4 deletions(-)

diff --git a/matita/matita/lib/turing/multi_universal/alphabet.ma b/matita/matita/lib/turing/multi_universal/alphabet.ma
index fdd433f07..1c4cd8060 100644
--- a/matita/matita/lib/turing/multi_universal/alphabet.ma
+++ b/matita/matita/lib/turing/multi_universal/alphabet.ma
@@ -42,6 +42,11 @@ definition FSUnialpha ≝
   mk_FinSet DeqUnialpha [bit true;bit false;null;bar] 
   unialpha_unique unialpha_complete.
 
+unification hint  0 ≔ ; 
+    X ≟ FSUnialpha
+(* ---------------------------------------- *) ⊢ 
+    unialpha ≡ FinSetcarr X.
+    
 (*************************** testing characters *******************************)
 definition is_bit ≝ λc.match c with [ bit _ ⇒ true | _ ⇒ false ].
 definition is_bar ≝ λc:DeqUnialpha. c == bar.
diff --git a/matita/matita/lib/turing/multi_universal/unistep_aux.ma b/matita/matita/lib/turing/multi_universal/unistep_aux.ma
index 4be6e129f..86f442783 100644
--- a/matita/matita/lib/turing/multi_universal/unistep_aux.ma
+++ b/matita/matita/lib/turing/multi_universal/unistep_aux.ma
@@ -13,6 +13,7 @@ include "turing/multi_universal/moves_2.ma".
 include "turing/multi_universal/match.ma".
 include "turing/multi_universal/copy.ma".
 include "turing/multi_universal/alphabet.ma".
+include "turing/multi_universal/tuples.ma".
 
 (*
 
@@ -267,7 +268,11 @@ qed.
 
 (* macchina che muove il nastro obj a destra o sinistra a seconda del valore
    del current di prg, che codifica la direzione in cui ci muoviamo *)
-   
+
+definition char_to_move ≝ λc.match c with
+  [ bit b ⇒ if b then R else L
+  | _ ⇒ N].
+  
 definition tape_move_obj : mTM FSUnialpha 2 ≝ 
   ifTM ?? 
    (inject_TM ? (test_char ? (λc:FSUnialpha.c == bit false)) 2 prg)
@@ -279,8 +284,54 @@ definition tape_move_obj : mTM FSUnialpha 2 ≝
     tc_true)
    tc_true.
 
+definition restart_tape ≝ λi. 
+  inject_TM ? (move_to_end FSUnialpha L) 2 i ·
+  mmove i FSUnialpha 2 R. 
+
 definition unistep ≝ 
   obj_to_cfg · match_m cfg prg FSUnialpha 2 · 
-  inject_TM ? (move_to_end FSUnialpha L) 2 cfg ·
-  mmove cfg FSUnialpha 2 R · copy prg cfg FSUnialpha 2 ·
-  cfg_to_obj · tape_move_obj.
\ No newline at end of file
+  restart_tape cfg · copy prg cfg FSUnialpha 2 ·
+  cfg_to_obj · tape_move_obj · restart_tape prg.
+
+(*
+definition legal_tape ≝ λn,l,h,t.
+  ∃state,char,table.
+  nth cfg ? t1 (niltape ?) = midtape ? [ ] bar (state@[char]) →
+  is_config n (bar::state@[char]) →  
+  nth prg ? t1 (niltape ?) = midtape ? [ ] bar table →
+  bar::table = table_TM n l h → *)
+
+definition list_of_tape ≝ λsig,t. 
+  left sig t@option_cons ? (current ? t) (right ? t).
+
+definition low_char' ≝ λc.
+  match c with
+  [ None ⇒ null 
+  | Some b ⇒ if (is_bit b) then b else null
+  ].
+  
+definition R_unistep ≝ λn,l,h.λt1,t2: Vector ? 3.
+  ∀state,oldc,table.
+  (* cfg *)
+  nth cfg ? t1 (niltape ?) = midtape ? [ ] bar (state@[oldc]) →
+  is_config n (bar::state@[oldc]) →  
+  (* prg *)
+  nth prg ? t1 (niltape ?) = midtape ? [ ] bar table →
+  bar::table = table_TM n l h →
+  (* obj *)
+  only_bits (list_of_tape ? (nth obj ? t1 (niltape ?))) →
+  let char ≝ low_char' (current ? (nth obj ? t1 (niltape ?))) in
+  let conf ≝ (bar::state@[char]) in
+  (∃ll,lr.bar::table = ll@conf@lr) → 
+    ∃nstate,nchar,m,t. tuple_encoding n h t = (conf@nstate@[nchar;m]) ∧ 
+    mem ? t l ∧
+    t2 = 
+      change_vec ??
+        (change_vec ?? t1 (midtape ? [ ] bar (nstate@[nchar])) cfg)
+        (tape_move_mono ? (nth obj ? t1 (niltape ?)) 〈Some ? nchar,char_to_move m〉) obj.
+    
+  
+  
+  
+  
+  
\ No newline at end of file
-- 
2.39.2