One of the foundational mathematical constructs behind computer science
is the universal Turing Machine.



(Alan Turing introduced the idea of such a machine in 1936–1937.)

Indeed one way to definitively prove that a language
is turing-complete
is to implement a universal Turing machine in it.



Task

Simulate such a machine capable
of taking the definition of any other Turing machine and executing it.

Of course, you will not have an infinite tape,
but you should emulate this as much as is possible.

The three permissible actions on the tape are "left", "right" and "stay".

To test your universal Turing machine (and prove your programming language
is Turing complete!), you should execute the following two Turing machines
based on the following definitions.


Simple incrementer

 States: q0, qf
 Initial state: q0
 Terminating states: qf
 Permissible symbols: B, 1
 Blank symbol: B
 Rules:
 (q0, 1, 1, right, q0)
 (q0, B, 1, stay, qf)


The input for this machine should be a tape of 1 1 1


Three-state busy beaver

 States: a, b, c, halt
 Initial state: a
 Terminating states: halt
 Permissible symbols: 0, 1
 Blank symbol: 0
 Rules:
 (a, 0, 1, right, b)
 (a, 1, 1, left, c)
 (b, 0, 1, left, a)
 (b, 1, 1, right, b)
 (c, 0, 1, left, b)
 (c, 1, 1, stay, halt)


The input for this machine should be an empty tape.


Bonus:

5-state, 2-symbol probable Busy Beaver machine from Wikipedia

 States: A, B, C, D, E, H
 Initial state: A
 Terminating states: H
 Permissible symbols: 0, 1
 Blank symbol: 0
 Rules:
 (A, 0, 1, right, B)
 (A, 1, 1, left, C)
 (B, 0, 1, right, C)
 (B, 1, 1, right, B)
 (C, 0, 1, right, D)
 (C, 1, 0, left, E)
 (D, 0, 1, left, A)
 (D, 1, 1, left, D)
 (E, 0, 1, stay, H)
 (E, 1, 0, left, A)


The input for this machine should be an empty tape.

This machine runs for more than 47 millions steps.




% 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