|
139
|
1 module utm where
|
|
|
2
|
|
|
3 open import turing
|
|
|
4 open import Data.Product
|
|
|
5 open import Data.Bool
|
|
|
6 open import Data.List
|
|
|
7 open import Data.Nat
|
|
|
8
|
|
|
9 data utmStates : Set where
|
|
140
|
10 reads : utmStates
|
|
139
|
11 read0 : utmStates
|
|
|
12 read1 : utmStates
|
|
|
13 read2 : utmStates
|
|
|
14 read3 : utmStates
|
|
|
15 read4 : utmStates
|
|
|
16 read5 : utmStates
|
|
|
17 read6 : utmStates
|
|
|
18
|
|
|
19 loc0 : utmStates
|
|
|
20 loc1 : utmStates
|
|
|
21 loc2 : utmStates
|
|
|
22 loc3 : utmStates
|
|
|
23 loc4 : utmStates
|
|
|
24 loc5 : utmStates
|
|
|
25 loc6 : utmStates
|
|
|
26
|
|
|
27 fetch0 : utmStates
|
|
|
28 fetch1 : utmStates
|
|
|
29 fetch2 : utmStates
|
|
|
30 fetch3 : utmStates
|
|
|
31 fetch4 : utmStates
|
|
|
32 fetch5 : utmStates
|
|
|
33 fetch6 : utmStates
|
|
|
34 fetch7 : utmStates
|
|
|
35
|
|
|
36 print0 : utmStates
|
|
|
37 print1 : utmStates
|
|
|
38 print2 : utmStates
|
|
|
39 print3 : utmStates
|
|
|
40 print4 : utmStates
|
|
|
41 print5 : utmStates
|
|
|
42 print6 : utmStates
|
|
|
43 print7 : utmStates
|
|
|
44
|
|
|
45 mov0 : utmStates
|
|
|
46 mov1 : utmStates
|
|
|
47 mov2 : utmStates
|
|
|
48 mov3 : utmStates
|
|
|
49 mov4 : utmStates
|
|
|
50 mov5 : utmStates
|
|
|
51 mov6 : utmStates
|
|
|
52
|
|
|
53 tidy0 : utmStates
|
|
|
54 tidy1 : utmStates
|
|
|
55 halt : utmStates
|
|
|
56
|
|
|
57 data utmΣ : Set where
|
|
|
58 ０ : utmΣ
|
|
|
59 １ : utmΣ
|
|
|
60 B : utmΣ
|
|
|
61 * : utmΣ
|
|
|
62 $ : utmΣ
|
|
|
63 ^ : utmΣ
|
|
|
64 X : utmΣ
|
|
|
65 Y : utmΣ
|
|
|
66 Z : utmΣ
|
|
|
67 ＠ : utmΣ
|
|
|
68 b : utmΣ
|
|
|
69
|
|
|
70 utmδ : utmStates → utmΣ → utmStates × (Write utmΣ) × Move
|
|
140
|
71 utmδ reads x = read0 , wnone , mnone
|
|
139
|
72 utmδ read0 * = read1 , write * , left
|
|
|
73 utmδ read0 x = read0 , write x , right
|
|
|
74 utmδ read1 x = read2 , write ＠ , right
|
|
|
75 utmδ read2 ^ = read3 , write ^ , right
|
|
|
76 utmδ read2 x = read2 , write x , right
|
|
|
77 utmδ read3 ０ = read4 , write ０ , left
|
|
|
78 utmδ read3 １ = read5 , write １ , left
|
|
|
79 utmδ read3 b = read6 , write b , left
|
|
|
80 utmδ read4 ＠ = loc0 , write ０ , right
|
|
|
81 utmδ read4 x = read4 , write x , left
|
|
|
82 utmδ read5 ＠ = loc0 , write １ , right
|
|
|
83 utmδ read5 x = read5 , write x , left
|
|
|
84 utmδ read6 ＠ = loc0 , write B , right
|
|
|
85 utmδ read6 x = read6 , write x , left
|
|
|
86 utmδ loc0 ０ = loc0 , write X , left
|
|
|
87 utmδ loc0 １ = loc0 , write Y , left
|
|
|
88 utmδ loc0 B = loc0 , write Z , left
|
|
|
89 utmδ loc0 $ = loc1 , write $ , right
|
|
|
90 utmδ loc0 x = loc0 , write x , left
|
|
|
91 utmδ loc1 X = loc2 , write ０ , right
|
|
|
92 utmδ loc1 Y = loc3 , write １ , right
|
|
|
93 utmδ loc1 Z = loc4 , write B , right
|
|
|
94 utmδ loc1 * = fetch0 , write * , right
|
|
|
95 utmδ loc1 x = loc1 , write x , right
|
|
|
96 utmδ loc2 ０ = loc5 , write X , right
|
|
|
97 utmδ loc2 １ = loc6 , write Y , right
|
|
|
98 utmδ loc2 B = loc6 , write Z , right
|
|
|
99 utmδ loc2 x = loc2 , write x , right
|
|
|
100 utmδ loc3 １ = loc5 , write Y , right
|
|
|
101 utmδ loc3 ０ = loc6 , write X , right
|
|
|
102 utmδ loc3 B = loc6 , write Z , right
|
|
|
103 utmδ loc3 x = loc3 , write x , right
|
|
|
104 utmδ loc4 B = loc5 , write Z , right
|
|
|
105 utmδ loc4 ０ = loc6 , write X , right
|
|
|
106 utmδ loc4 １ = loc6 , write Y , right
|
|
|
107 utmδ loc4 x = loc4 , write x , right
|
|
|
108 utmδ loc5 $ = loc1 , write $ , right
|
|
|
109 utmδ loc5 x = loc5 , write x , left
|
|
|
110 utmδ loc6 $ = halt , write $ , right
|
|
|
111 utmδ loc6 * = loc0 , write * , left
|
|
|
112 utmδ loc6 x = loc6 , write x , right
|
|
|
113 utmδ fetch0 ０ = fetch1 , write X , left
|
|
|
114 utmδ fetch0 １ = fetch2 , write Y , left
|
|
|
115 utmδ fetch0 B = fetch3 , write Z , left
|
|
|
116 utmδ fetch0 x = fetch0 , write x , right
|
|
|
117 utmδ fetch1 $ = fetch4 , write $ , right
|
|
|
118 utmδ fetch1 x = fetch1 , write x , left
|
|
|
119 utmδ fetch2 $ = fetch5 , write $ , right
|
|
|
120 utmδ fetch2 x = fetch2 , write x , left
|
|
|
121 utmδ fetch3 $ = fetch6 , write $ , right
|
|
|
122 utmδ fetch3 x = fetch3 , write x , left
|
|
|
123 utmδ fetch4 ０ = fetch7 , write X , right
|
|
|
124 utmδ fetch4 １ = fetch7 , write X , right
|
|
|
125 utmδ fetch4 B = fetch7 , write X , right
|
|
|
126 utmδ fetch4 * = print0 , write * , left
|
|
|
127 utmδ fetch4 x = fetch4 , write x , right
|
|
|
128 utmδ fetch5 ０ = fetch7 , write Y , right
|
|
|
129 utmδ fetch5 １ = fetch7 , write Y , right
|
|
|
130 utmδ fetch5 B = fetch7 , write Y , right
|
|
|
131 utmδ fetch5 * = print0 , write * , left
|
|
|
132 utmδ fetch5 x = fetch5 , write x , right
|
|
|
133 utmδ fetch6 ０ = fetch7 , write Z , right
|
|
|
134 utmδ fetch6 １ = fetch7 , write Z , right
|
|
|
135 utmδ fetch6 B = fetch7 , write Z , right
|
|
|
136 utmδ fetch6 * = print0 , write * , left
|
|
|
137 utmδ fetch6 x = fetch6 , write x , right
|
|
|
138 utmδ fetch7 * = fetch0 , write * , right
|
|
|
139 utmδ fetch7 x = fetch7 , write x , right
|
|
|
140 utmδ print0 X = print1 , write X , right
|
|
|
141 utmδ print0 Y = print2 , write Y , right
|
|
|
142 utmδ print0 Z = print3 , write Z , right
|
|
|
143 utmδ print1 ^ = print4 , write ^ , right
|
|
|
144 utmδ print1 x = print1 , write x , right
|
|
|
145 utmδ print2 ^ = print5 , write ^ , right
|
|
|
146 utmδ print2 x = print2 , write x , right
|
|
|
147 utmδ print3 ^ = print6 , write ^ , right
|
|
|
148 utmδ print3 x = print3 , write x , right
|
|
|
149 utmδ print4 x = print7 , write ０ , left
|
|
|
150 utmδ print5 x = print7 , write １ , left
|
|
|
151 utmδ print6 x = print7 , write B , left
|
|
|
152 utmδ print7 X = mov0 , write X , right
|
|
|
153 utmδ print7 Y = mov1 , write Y , right
|
|
|
154 utmδ print7 x = print7 , write x , left
|
|
|
155 utmδ mov0 ^ = mov2 , write ^ , left
|
|
|
156 utmδ mov0 x = mov0 , write x , right
|
|
|
157 utmδ mov1 ^ = mov3 , write ^ , right
|
|
|
158 utmδ mov1 x = mov1 , write x , right
|
|
|
159 utmδ mov2 ０ = mov4 , write ^ , right
|
|
|
160 utmδ mov2 １ = mov5 , write ^ , right
|
|
|
161 utmδ mov2 B = mov6 , write ^ , right
|
|
|
162 utmδ mov3 ０ = mov4 , write ^ , left
|
|
|
163 utmδ mov3 １ = mov5 , write ^ , left
|
|
|
164 utmδ mov3 B = mov6 , write ^ , left
|
|
|
165 utmδ mov4 ^ = tidy0 , write ０ , left
|
|
|
166 utmδ mov5 ^ = tidy0 , write １ , left
|
|
|
167 utmδ mov6 ^ = tidy0 , write B , left
|
|
|
168 utmδ tidy0 $ = tidy1 , write $ , left
|
|
|
169 utmδ tidy0 x = tidy0 , write x , left
|
|
|
170 utmδ tidy1 X = tidy1 , write ０ , left
|
|
|
171 utmδ tidy1 Y = tidy1 , write １ , left
|
|
|
172 utmδ tidy1 Z = tidy1 , write B , left
|
|
141
|
173 utmδ tidy1 $ = reads , write $ , right
|
|
139
|
174 utmδ tidy1 x = tidy1 , write x , left
|
|
|
175 utmδ _ x = halt , write x , mnone
|
|
|
176
|
|
|
177 U-TM : Turing utmStates utmΣ
|
|
|
178 U-TM = record {
|
|
|
179 tδ = utmδ
|
|
|
180 ; tstart = read0
|
|
|
181 ; tend = tend
|
|
|
182 ; tnone = b
|
|
|
183 } where
|
|
|
184 tend : utmStates → Bool
|
|
|
185 tend halt = true
|
|
|
186 tend _ = false
|
|
|
187
|
|
|
188 -- Copyδ : CopyStates → ℕ → CopyStates × ( Write ℕ ) × Move
|
|
|
189 -- Copyδ s1 0 = H , wnone , mnone
|
|
|
190 -- Copyδ s1 1 = s2 , write 0 , right
|
|
|
191 -- Copyδ s2 0 = s3 , write 0 , right
|
|
|
192 -- Copyδ s2 1 = s2 , write 1 , right
|
|
|
193 -- Copyδ s3 0 = s4 , write 1 , left
|
|
|
194 -- Copyδ s3 1 = s3 , write 1 , right
|
|
|
195 -- Copyδ s4 0 = s5 , write 0 , left
|
|
|
196 -- Copyδ s4 1 = s4 , write 1 , left
|
|
|
197 -- Copyδ s5 0 = s1 , write 1 , right
|
|
|
198 -- Copyδ s5 1 = s5 , write 1 , left
|
|
|
199 -- Copyδ H _ = H , wnone , mnone
|
|
|
200 -- Copyδ _ (suc (suc _)) = H , wnone , mnone
|
|
|
201
|
|
|
202 Copyδ-encode : List utmΣ
|
|
|
203 Copyδ-encode =
|
|
|
204 ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ -- s1 0 = H , wnone , mnone
|
|
|
205 * ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ -- s1 1 = s2 , write 0 , right
|
|
|
206 * ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ -- s2 0 = s3 , write 0 , right
|
|
|
207 * ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ -- s2 1 = s2 , write 1 , right
|
|
|
208 * ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s3 0 = s4 , write 1 , left
|
|
|
209 * ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s3 1 = s3 , write 1 , right
|
|
|
210 * ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ -- s4 0 = s5 , write 0 , left
|
|
|
211 * ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ -- s4 1 = s4 , write 1 , left
|
|
|
212 * ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ -- s5 0 = s1 , write 1 , right
|
|
|
213 * ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ ０ ∷ ０ ∷ -- s5 1 = s5 , write 1 , left
|
|
|
214 []
|
|
|
215
|
|
|
216
|
|
|
217 input-encode : List utmΣ
|
|
|
218 input-encode = １ ∷ １ ∷ ０ ∷ ０ ∷ ０ ∷ []
|
|
|
219
|
|
|
220 input+Copyδ : List utmΣ
|
|
|
221 input+Copyδ = ( $ ∷ ０ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷ [] ) -- start state
|
|
|
222 ++ Copyδ-encode
|
|
|
223 ++ ( $ ∷ ^ ∷ input-encode )
|
|
|
224
|
|
140
|
225 short-input : List utmΣ
|
|
|
226 short-input = $ ∷ ０ ∷ ０ ∷ ０ ∷ * ∷
|
|
|
227 ０ ∷ ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ * ∷
|
|
|
228 ０ ∷ ０ ∷ １ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ * ∷
|
|
|
229 ０ ∷ １ ∷ B ∷ １ ∷ ０ ∷ １ ∷ ０ ∷ * ∷
|
|
|
230 １ ∷ ０ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ １ ∷ $ ∷
|
|
|
231 ^ ∷ ０ ∷ ０ ∷ １ ∷ １ ∷ []
|
|
139
|
232
|
|
140
|
233 utm-test1 : List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ )
|
|
|
234 utm-test1 inp = Turing.taccept U-TM inp
|
|
|
235
|
|
|
236 {-# TERMINATING #-}
|
|
|
237 utm-test2 : ℕ → List utmΣ → utmStates × ( List utmΣ ) × ( List utmΣ )
|
|
|
238 utm-test2 n inp = loop n (Turing.tstart U-TM) inp []
|
|
139
|
239 where
|
|
|
240 loop : ℕ → utmStates → ( List utmΣ ) → ( List utmΣ ) → utmStates × ( List utmΣ ) × ( List utmΣ )
|
|
|
241 loop zero q L R = ( q , L , R )
|
|
140
|
242 loop (suc n) q L R with move {utmStates} {utmΣ} {０} {utmδ} q L R | q
|
|
|
243 ... | nq , nL , nR | reads = loop n nq nL nR
|
|
|
244 ... | nq , nL , nR | _ = loop (suc n) nq nL nR
|
|
139
|
245
|
|
140
|
246 t1 = utm-test2 20 short-input
|
|
|
247
|
|
|
248 t : (n : ℕ) → utmStates × ( List utmΣ ) × ( List utmΣ )
|
|
141
|
249 -- t n = utm-test2 n input+Copyδ
|
|
|
250 t n = utm-test2 n short-input
|
