1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
(** [check_input input blank] does sanity checks on input and returns its length
if all is good *)
let check_input input alphabet blank =
if String.contains input (String.get blank 0) then
Utils.error "Invalid input, blank character cannot be in input"
else
String.iter
(fun c ->
if not (List.exists (fun alpha -> String.get alpha 0 = c) alphabet) then
Utils.error "Invalid input, unknown character cannot be in input"
else
() )
input;
match String.length input with
| 0 -> Utils.error "Invalid input, length = 0"
| n -> n
(** [convert input blank length] convert a string input into a resizable vector *)
let convert input blank length =
let tape = CCVector.make length blank in
String.iteri (fun i cc -> CCVector.set tape i (String.make 1 cc)) input;
tape
(** [is_final tbl state] simple boolean to check if a state is contained in the
Hashtbl of all known states *)
let is_final tbl state =
match Hashtbl.find_opt tbl state with
| None -> false
| Some answer -> (
match answer with
| _, false -> false
| _, true -> true )
(** [is_blocked tape state read index state_tbl print] *)
let is_blocked fmt tape state read index ~print =
let is_blocked =
Pp.blocked_tape fmt
(CCVector.to_string ~sep:"" Fun.id tape, index)
state read print
in
is_blocked
(Format.sprintf "BLOCKED@.transition (%s, %s) is undefined" state read)
(** [terminate current_state read print tape index state_tbl] is called when
machine is estimated to be in a final or blocked state *)
let terminate fmt current_state read print tape index state_tbl =
if is_final state_tbl current_state then
()
else
is_blocked fmt tape current_state read index ~print
(** [move_direction direction] converts a given action field direction to an
incrementation or decrementation of the index in the recursive
interpretation *)
let move_direction =
let open Lang in
function
| Right -> 1
| Left -> -1
let tape_size = ref 0
let blank_char = ref ""
let index_checker index tape =
let size = CCVector.size tape in
if index < 0 then (
CCVector.rev_in_place tape;
CCVector.push tape !blank_char;
CCVector.rev_in_place tape;
0
) else if index >= size then (
CCVector.push tape !blank_char;
index
) else
index
(** [execution tables tape index current_state] recursively reads and writes on
given [tape] at given [index] in regards to [current state] by following the
transitions found in transitions and states [tables] *)
let rec execution fmt ~print ((state_tbl, transitions_tbl) as tables) tape index
current_state =
let index = index_checker index tape in
let read = CCVector.get tape index in
match Hashtbl.find_opt transitions_tbl (current_state, read) with
| None -> terminate fmt current_state read print tape index state_tbl
| Some ((next_state, write, direction) as transition) ->
let current_tape = CCVector.to_string ~sep:"" Fun.id tape in
Pp.current_tape fmt current_tape index
((current_state, read), transition)
print;
CCVector.set tape index write;
execution fmt ~print tables tape
(index + move_direction direction)
next_state
(** [interpreter machine input] function sets up the execution of the turing
machine [machine] on the [input]. *)
let interpreter fmt (machine, input) =
let alphabet, blank, initial, tables = machine in
let initial_length = check_input input alphabet blank in
let tape1 = convert input blank (initial_length * 2) in
let read = CCVector.get tape1 0 in
if not (List.mem read alphabet) then
is_blocked fmt tape1 initial read 0 ~print:true
else (
blank_char := blank;
execution fmt ~print:false tables tape1 0 initial;
tape_size := CCVector.size tape1;
let tape2 = convert input blank !tape_size in
execution fmt ~print:true tables tape2 0 initial
)