258 lines
7.7 KiB
Plaintext
258 lines
7.7 KiB
Plaintext
% Bidirectional 'infinite' tape
|
|
tape = cluster [T: type] is make, left, right, get_cell, set_cell,
|
|
elements, get_size
|
|
rep = record[
|
|
blank: T,
|
|
loc: int,
|
|
data: array[T]
|
|
]
|
|
|
|
% Make a new tape with a given blank value and initial value
|
|
make = proc (blank: T, init: sequence[T]) returns (cvt)
|
|
data: array[T]
|
|
if sequence[T]$empty(init) then
|
|
data := array[T]$[blank]
|
|
else
|
|
data := sequence[T]$s2a(init)
|
|
end
|
|
return(rep${
|
|
blank: blank,
|
|
loc: 1,
|
|
data: data
|
|
})
|
|
end make
|
|
|
|
% Move the tape head left
|
|
left = proc (tap: cvt)
|
|
tap.loc := tap.loc - 1
|
|
if tap.loc < array[T]$low(tap.data) then
|
|
array[T]$addl(tap.data,tap.blank)
|
|
end
|
|
end left
|
|
|
|
% Move the tape head right
|
|
right = proc (tap: cvt)
|
|
tap.loc := tap.loc + 1
|
|
if tap.loc > array[T]$high(tap.data) then
|
|
array[T]$addh(tap.data,tap.blank)
|
|
end
|
|
end right
|
|
|
|
% Get the value of the current cell
|
|
get_cell = proc (tap: cvt) returns (T)
|
|
return(tap.data[tap.loc])
|
|
end get_cell
|
|
|
|
% Set the value of the current cell
|
|
set_cell = proc (tap: cvt, val: T)
|
|
tap.data[tap.loc] := val
|
|
end set_cell
|
|
|
|
% Retrieve all touched values, one by one, from left to right
|
|
elements = iter (tap: cvt) yields (T)
|
|
for v: T in array[T]$elements(tap.data) do
|
|
yield(v)
|
|
end
|
|
end elements
|
|
|
|
% Get the current size of the tape
|
|
get_size = proc (tap: cvt) returns (int)
|
|
return(array[T]$size(tap.data))
|
|
end get_size
|
|
end tape
|
|
|
|
% Turing machine state table
|
|
turing = cluster [T: type] is make, add_rule, run
|
|
where T has equal: proctype (T,T) returns (bool)
|
|
A_LEFT = 'L'
|
|
A_RIGHT = 'R'
|
|
A_STAY = 'S'
|
|
|
|
state = record[name: string, term: bool]
|
|
rule = struct[
|
|
cur_state: int,
|
|
read_sym, write_sym: T,
|
|
action: char,
|
|
next_state: int
|
|
]
|
|
|
|
rep = struct[
|
|
states: array[state],
|
|
rules: array[rule],
|
|
init_state: int
|
|
]
|
|
|
|
% Find the index of a state given its name
|
|
find_state = proc (states: array[state], name: string)
|
|
returns (int) signals (bad_state)
|
|
for i: int in array[state]$indexes(states) do
|
|
if states[i].name = name then return(i) end
|
|
end
|
|
signal bad_state
|
|
end find_state
|
|
|
|
% Make a new Turing machine given a list of states
|
|
make = proc (state_seq: sequence[string], init: string, term: sequence[string])
|
|
returns (cvt) signals (bad_state)
|
|
states: array[state] := array[state]$[]
|
|
for s: string in sequence[string]$elements(state_seq) do
|
|
array[state]$addh(states, state${name: s, term: false} )
|
|
end
|
|
|
|
init_n: int := find_state(states, init) resignal bad_state
|
|
for s: string in sequence[string]$elements(term) do
|
|
term_n: int := find_state(states, s) resignal bad_state
|
|
states[term_n].term := true
|
|
end
|
|
return(rep${states: states,
|
|
init_state: init_n,
|
|
rules: array[rule]$[]})
|
|
end make
|
|
|
|
% Add a rule to the Turing machine
|
|
add_rule = proc (tur: cvt,
|
|
in_state: string,
|
|
read_sym, write_sym: T,
|
|
action: string,
|
|
out_state: string)
|
|
signals (bad_state, bad_action)
|
|
cur_state: int := find_state(tur.states, in_state) resignal bad_state
|
|
next_state: int := find_state(tur.states, out_state) resignal bad_state
|
|
|
|
act: char
|
|
if action = "left" then act := A_LEFT
|
|
elseif action = "right" then act := A_RIGHT
|
|
elseif action = "stay" then act := A_STAY
|
|
else signal bad_action
|
|
end
|
|
|
|
array[rule]$addh(tur.rules,
|
|
rule${cur_state: cur_state,
|
|
read_sym: read_sym,
|
|
write_sym: write_sym,
|
|
action: act,
|
|
next_state: next_state})
|
|
end add_rule
|
|
|
|
% Find first matching rule
|
|
find_rule = proc (rules: array[rule], st: int, sym: T)
|
|
returns (rule) signals (no_rule)
|
|
for r: rule in array[rule]$elements(rules) do
|
|
if r.cur_state = st & r.read_sym = sym then
|
|
return(r)
|
|
end
|
|
end
|
|
signal no_rule
|
|
end find_rule
|
|
|
|
% Run the Turing machine on a given tape until it terminates
|
|
run = proc (tur: cvt, tap: tape[T]) signals (no_rule)
|
|
cur: int := tur.init_state
|
|
while ~tur.states[cur].term do
|
|
r: rule := find_rule(tur.rules, cur, tap.cell) resignal no_rule
|
|
tap.cell := r.write_sym
|
|
if r.action = A_LEFT then tape[T]$left(tap)
|
|
elseif r.action = A_RIGHT then tape[T]$right(tap)
|
|
end
|
|
cur := r.next_state
|
|
end
|
|
end run
|
|
end turing
|
|
|
|
|
|
% Simple incrementer
|
|
simple_incrementer = proc () returns (turing[char])
|
|
tc = turing[char]
|
|
t: tc := tc$make(
|
|
sequence[string]$["q0", "qf"],
|
|
"q0",
|
|
sequence[string]$["qf"]
|
|
)
|
|
|
|
tc$add_rule(t, "q0", '1', '1', "right", "q0")
|
|
tc$add_rule(t, "q0", 'B', '1', "stay", "qf")
|
|
return(t)
|
|
end simple_incrementer
|
|
|
|
% Three state beaver
|
|
three_state_beaver = proc () returns (turing[char])
|
|
tc = turing[char]
|
|
t: tc := tc$make(
|
|
sequence[string]$["a", "b", "c", "halt"],
|
|
"a",
|
|
sequence[string]$["halt"]
|
|
)
|
|
|
|
tc$add_rule(t, "a", '0', '1', "right", "b")
|
|
tc$add_rule(t, "a", '1', '1', "left", "c")
|
|
tc$add_rule(t, "b", '0', '1', "left", "a")
|
|
tc$add_rule(t, "b", '1', '1', "right", "b")
|
|
tc$add_rule(t, "c", '0', '1', "left", "b")
|
|
tc$add_rule(t, "c", '1', '1', "stay", "halt")
|
|
return(t)
|
|
end three_state_beaver
|
|
|
|
% Five state beaver
|
|
five_state_beaver = proc () returns (turing[char])
|
|
tc = turing[char]
|
|
t: tc := tc$make(
|
|
sequence[string]$["A", "B", "C", "D", "E", "H"],
|
|
"A",
|
|
sequence[string]$["H"]
|
|
)
|
|
|
|
tc$add_rule(t, "A", '0', '1', "right", "B")
|
|
tc$add_rule(t, "A", '1', '1', "left", "C")
|
|
tc$add_rule(t, "B", '0', '1', "right", "C")
|
|
tc$add_rule(t, "B", '1', '1', "right", "B")
|
|
tc$add_rule(t, "C", '0', '1', "right", "D")
|
|
tc$add_rule(t, "C", '1', '0', "left", "E")
|
|
tc$add_rule(t, "D", '0', '1', "left", "A")
|
|
tc$add_rule(t, "D", '1', '1', "left", "D")
|
|
tc$add_rule(t, "E", '0', '1', "stay", "H")
|
|
tc$add_rule(t, "E", '1', '0', "left", "A")
|
|
return(t)
|
|
end five_state_beaver
|
|
|
|
% Print the first 32 touched symbols on a tape
|
|
print_tape = proc (s: stream, t: tape[char])
|
|
n: int := 32
|
|
for c: char in tape[char]$elements(t) do
|
|
stream$putc(s, c)
|
|
n := n - 1
|
|
if n=0 then break end
|
|
end
|
|
|
|
if n=0 then
|
|
stream$puts(s, "... (length: " || int$unparse(t.size) || ")")
|
|
end
|
|
stream$putl(s, "")
|
|
end print_tape
|
|
|
|
% Run the three Turing machines and show the results
|
|
start_up = proc ()
|
|
turing_factory = proctype () returns (turing[char])
|
|
test = record[name: string, tf: turing_factory, tap: tape[char]]
|
|
stest = sequence[test]
|
|
sc = sequence[char]
|
|
|
|
tests: stest := stest$[
|
|
test${name: "Simple incrementer",
|
|
tf: simple_incrementer,
|
|
tap: tape[char]$make('B', sc$['1','1','1'])},
|
|
test${name: "Three-state busy beaver",
|
|
tf: three_state_beaver,
|
|
tap: tape[char]$make('0', sc$[])},
|
|
test${name: "Five-state probable busy beaver",
|
|
tf: five_state_beaver,
|
|
tap: tape[char]$make('0', sc$[])}]
|
|
|
|
po: stream := stream$primary_output()
|
|
for t: test in stest$elements(tests) do
|
|
stream$puts(po, t.name || ": ")
|
|
tm: turing[char] := t.tf()
|
|
turing[char]$run(tm, t.tap)
|
|
print_tape(po, t.tap)
|
|
end
|
|
end start_up
|