]> matita.cs.unibo.it Git - helm.git/blob - matita/matita/lib/turing/mono.ma
loop functions
[helm.git] / matita / matita / lib / turing / mono.ma
1 (*
2     ||M||  This file is part of HELM, an Hypertextual, Electronic   
3     ||A||  Library of Mathematics, developed at the Computer Science 
4     ||T||  Department of the University of Bologna, Italy.           
5     ||I||                                                            
6     ||T||  
7     ||A||  
8     \   /  This file is distributed under the terms of the       
9      \ /   GNU General Public License Version 2   
10       V_____________________________________________________________*)
11
12 include "basics/vectors.ma".
13 (* include "basics/relations.ma". *)
14
15 record tape (sig:FinSet): Type[0] ≝ 
16 { left : list sig;
17   right: list sig
18 }.
19
20 inductive move : Type[0] ≝
21 | L : move 
22 | R : move
23 .
24
25 (* We do not distinuish an input tape *)
26
27 record TM (sig:FinSet): Type[1] ≝ 
28 { states : FinSet;
29   trans : states × (option sig) → states × (option (sig × move));
30   start: states;
31   halt : states → bool
32 }.
33
34 record config (sig:FinSet) (M:TM sig): Type[0] ≝ 
35 { cstate : states sig M;
36   ctape: tape sig
37 }.
38
39 definition option_hd ≝ λA.λl:list A.
40   match l with
41   [nil ⇒ None ?
42   |cons a _ ⇒ Some ? a
43   ].
44
45 definition tape_move ≝ λsig.λt: tape sig.λm:option (sig × move).
46   match m with 
47   [ None ⇒ t
48   | Some m1 ⇒ 
49     match \snd m1 with
50     [ R ⇒ mk_tape sig ((\fst m1)::(left ? t)) (tail ? (right ? t))
51     | L ⇒ mk_tape sig (tail ? (left ? t)) ((\fst m1)::(right ? t))
52     ]
53   ].
54
55 definition step ≝ λsig.λM:TM sig.λc:config sig M.
56   let current_char ≝ option_hd ? (right ? (ctape ?? c)) in
57   let 〈news,mv〉 ≝ trans sig M 〈cstate ?? c,current_char〉 in
58   mk_config ?? news (tape_move sig (ctape ?? c) mv).
59   
60 let rec loop (A:Type[0]) n (f:A→A) p a on n ≝
61   match n with 
62   [ O ⇒ None ?
63   | S m ⇒ if p a then (Some ? a) else loop A m f p (f a)
64   ].
65
66 axiom loop_incr : ∀A,f,p,k1,k2,a1,a2. 
67   loop A k1 f p a1 = Some ? a2 → 
68     loop A (k2+k1) f p a1 = Some ? a2.
69    
70 lemma loop_split : ∀A,f,p,q.(∀b. p b = false → q b = false) →
71  ∀k1,k2,a1,a2,a3. 
72    loop A k1 f p a1 = Some ? a2 → 
73      loop A k2 f q a2 = Some ? a3 →
74        loop A (k1+k2) f q a1 = Some ? a3.
75 #Sig #f #p #q #Hpq #k1 elim k1 
76   [normalize #k2 #a1 #a2 #a3 #H destruct
77   |#k1' #Hind #k2 #a1 #a2 #a3 normalize in ⊢ (%→?→?);
78    cases (true_or_false (p a1)) #pa1 >pa1 normalize in ⊢ (%→?);
79    [#eqa1a2 destruct #H @loop_incr //
80    |normalize >(Hpq … pa1) normalize 
81     #H1 #H2 @(Hind … H2) //
82    ]
83  ]
84 qed.
85
86 definition initc ≝ λsig.λM:TM sig.λt.
87   mk_config sig M (start sig M) t.
88
89 definition Realize ≝ λsig.λM:TM sig.λR:relation (tape sig).
90 ∀t.∃i.∃outc.
91   loop ? i (step sig M) (λc.halt sig M (cstate ?? c)) (initc sig M t) = Some ? outc ∧
92   R t (ctape ?? outc).
93
94 (* Compositions *)
95
96 definition seq_trans ≝ λsig. λM1,M2 : TM sig. 
97 λp. let 〈s,a〉 ≝ p in
98   match s with 
99   [ inl s1 ⇒ 
100       if halt sig M1 s1 then 〈inr … (start sig M2), None ?〉
101       else 
102       let 〈news1,m〉 ≝ trans sig M1 〈s1,a〉 in
103       〈inl … news1,m〉
104   | inr s2 ⇒ 
105       let 〈news2,m〉 ≝ trans sig M2 〈s2,a〉 in
106       〈inr … news2,m〉
107   ].
108  
109 definition seq ≝ λsig. λM1,M2 : TM sig. 
110   mk_TM sig 
111     (FinSum (states sig M1) (states sig M2))
112     (seq_trans sig M1 M2) 
113     (inl … (start sig M1))
114     (λs.match s with
115       [ inl _ ⇒ false | inr s2 ⇒ halt sig M2 s2]). 
116
117 definition Rcomp ≝ λA.λR1,R2:relation A.λa1,a2.
118   ∃am.R1 a1 am ∧ R2 am a2.
119
120 (*
121 definition injectRl ≝ λsig.λM1.λM2.λR.
122    λc1,c2. ∃c11,c12. 
123      inl … (cstate sig M1 c11) = cstate sig (seq sig M1 M2) c1 ∧ 
124      inl … (cstate sig M1 c12) = cstate sig (seq sig M1 M2) c2 ∧
125      ctape sig M1 c11 = ctape sig (seq sig M1 M2) c1 ∧ 
126      ctape sig M1 c12 = ctape sig (seq sig M1 M2) c2 ∧ 
127      R c11 c12.
128
129 definition injectRr ≝ λsig.λM1.λM2.λR.
130    λc1,c2. ∃c21,c22. 
131      inr … (cstate sig M2 c21) = cstate sig (seq sig M1 M2) c1 ∧ 
132      inr … (cstate sig M2 c22) = cstate sig (seq sig M1 M2) c2 ∧
133      ctape sig M2 c21 = ctape sig (seq sig M1 M2) c1 ∧ 
134      ctape sig M2 c22 = ctape sig (seq sig M1 M2) c2 ∧ 
135      R c21 c22.
136      
137 definition Rlink ≝ λsig.λM1,M2.λc1,c2.
138   ctape sig (seq sig M1 M2) c1 = ctape sig (seq sig M1 M2) c2 ∧
139   cstate sig (seq sig M1 M2) c1 = inl … (halt sig M1) ∧
140   cstate sig (seq sig M1 M2) c2 = inr … (start sig M2). *)
141   
142 interpretation "relation composition" 'compose R1 R2 = (Rcomp ? R1 R2).
143
144 theorem sem_seq: ∀sig,M1,M2,R1,R2.
145   Realize sig M1 R1 → Realize sig M2 R2 → 
146     Realize sig (seq sig M1 M2) (R1 ∘ R2).
147 #sig #M1 #M2 #R1 #R2 #HR1 #HR2 #t 
148 cases (HR1 t) #k1 * #outc1 * #Hloop1 #HM1
149 cases (HR2 (ctape sig M1 outc1)) #k2 * #outc2 * #Hloop2 #HM2
150 @(ex_intro … (S(k1+k2))) @
151
152
153
154
155 definition empty_tapes ≝ λsig.λn.
156 mk_Vector ? n (make_list (tape sig) (mk_tape sig [] []) n) ?.
157 elim n // normalize //
158 qed.
159
160 definition init ≝ λsig.λM:TM sig.λi:(list sig).
161   mk_config ??
162     (start sig M)
163     (vec_cons ? (mk_tape sig [] i) ? (empty_tapes sig (tapes_no sig M)))
164     [ ].
165
166 definition stop ≝ λsig.λM:TM sig.λc:config sig M.
167   halt sig M (state sig M c).
168
169 let rec loop (A:Type[0]) n (f:A→A) p a on n ≝
170   match n with 
171   [ O ⇒ None ?
172   | S m ⇒ if p a then (Some ? a) else loop A m f p (f a)
173   ].
174
175 (* Compute ? M f states that f is computed by M *)
176 definition Compute ≝ λsig.λM:TM sig.λf:(list sig) → (list sig).
177 ∀l.∃i.∃c.
178   loop ? i (step sig M) (stop sig M) (init sig M l) = Some ? c ∧
179   out ?? c = f l.
180
181 (* for decision problems, we accept a string if on termination
182 output is not empty *)
183
184 definition ComputeB ≝ λsig.λM:TM sig.λf:(list sig) → bool.
185 ∀l.∃i.∃c.
186   loop ? i (step sig M) (stop sig M) (init sig M l) = Some ? c ∧
187   (isnilb ? (out ?? c) = false).
188
189 (* alternative approach.
190 We define the notion of computation. The notion must be constructive,
191 since we want to define functions over it, like lenght and size 
192
193 Perche' serve Type[2] se sposto a e b a destra? *)
194
195 inductive cmove (A:Type[0]) (f:A→A) (p:A →bool) (a,b:A): Type[0] ≝
196   mk_move: p a = false → b = f a → cmove A f p a b.
197   
198 inductive cstar (A:Type[0]) (M:A→A→Type[0]) : A →A → Type[0] ≝
199 | empty : ∀a. cstar A M a a
200 | more : ∀a,b,c. M a b → cstar A M b c → cstar A M a c.
201
202 definition computation ≝ λsig.λM:TM sig.
203   cstar ? (cmove ? (step sig M) (stop sig M)).
204
205 definition Compute_expl ≝ λsig.λM:TM sig.λf:(list sig) → (list sig).
206   ∀l.∃c.computation sig M (init sig M l) c → 
207    (stop sig M c = true) ∧ out ?? c = f l.
208
209 definition ComputeB_expl ≝ λsig.λM:TM sig.λf:(list sig) → bool.
210   ∀l.∃c.computation sig M (init sig M l) c → 
211    (stop sig M c = true) ∧ (isnilb ? (out ?? c) = false).