Universal Turing machine

Universal Turing machine
You are encouraged to solve this task according to the task description, using any language you may know.

One of the foundational mathematical constructs behind computer science is the universal Turing Machine. Indeed one way to definitively prove that a language is Turing complete is to implement a universal Turing machine in it.

The task

For this task you would simulate such a machine capable of taking the definition of any other Turing machine and executing it. You will not, of course, 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.

Mercury

The universal machine

Source for this example was lightly adapted from https://bitbucket.org/ttmrichter/turing. Of particular interest in this implementation is that because of the type parameterisation of the config type, the machine being simulated cannot be compiled if there is any mistake in the states, symbols and actions. Also, because of Mercury's determinism detection and enforcement, it's impossible to pass in a non-deterministic set of rules. At most one answer can come back from the rules interface. <lang mercury>:- module turing.

- interface.

- import_module list.

- import_module set.

- type config(State, Symbol)

   ---> config(initial_state  :: State,
               halting_states :: set(State),
               blank          :: Symbol ).

- type action ---> left ; stay ; right.

- func turing(config(State, Symbol),

              pred(State, Symbol, Symbol, action, State),
              list(Symbol)) = list(Symbol).

- mode turing(in,

              pred(in, in, out, out, out) is semidet,
              in) = out is det.

- implementation.

- import_module pair.

- import_module require.

turing(Config@config(Start, _, _), Rules, Input) = Output :-

   (Left-Right) = perform(Config, Rules, Start, ([]-Input)),
   Output = append(reverse(Left), Right).

- func perform(config(State, Symbol),

               pred(State, Symbol, Symbol, action, State),
               State, pair(list(Symbol))) = pair(list(Symbol)).

- mode perform(in, pred(in, in, out, out, out) is semidet,

               in, in) = out is det.

perform(Config@config(_, Halts, Blank), Rules, State,

       Input@(LeftInput-RightInput)) = Output :-
   symbol(RightInput, Blank, RightNew, Symbol),
   ( set.member(State, Halts) ->
       Output = Input
   ; Rules(State, Symbol, NewSymbol, Action, NewState) ->
       NewLeft  = pair(LeftInput, [NewSymbol|RightNew]),
       NewRight = action(Action, Blank, NewLeft),
       Output   = perform(Config, Rules, NewState, NewRight)
   ;
       error("an impossible state has apparently become possible") ).

- pred symbol(list(Symbol), Symbol, list(Symbol), Symbol).

- mode symbol(in, in, out, out) is det.

symbol([], Blank, [], Blank). symbol([Sym|Rem], _, Rem, Sym).

- func action(action, State, pair(list(State))) = pair(list(State)).

action(left, Blank, ([]-Right)) = ([]-[Blank|Right]). action(left, _, ([Left|Lefts]-Rights)) = (Lefts-[Left|Rights]). action(stay, _, Tape) = Tape. action(right, Blank, (Left-[])) = ([Blank|Left]-[]). action(right, _, (Left-[Right|Rights])) = ([Right|Left]-Rights).</lang>

The incrementer machine

This machine has been stripped of the Mercury ceremony around modules, imports, etc. <lang mercury>:- type incrementer_states ---> a ; halt.

- type incrementer_symbols ---> b ; '1'.

- func incrementer_config = config(incrementer_states, incrementer_symbols).

incrementer_config = config(a,  % the initial state

                           set([halt]), % the set of halting states
                           b).          % the blank symbol

- pred incrementer(incrementer_states::in,

                   incrementer_symbols::in,
                   incrementer_symbols::out,
                   action::out,
                   incrementer_states::out) is semidet.

incrementer(a, '1', '1', right, a). incrementer(a, b, '1', stay, halt).

TapeOut = turing(incrementer_config, incrementer, [1, 1, 1]).</lang> This will, on execution, fill TapeOut with [1, 1, 1, 1].

The busy beaver machine

This machine has been stripped of the Mercury ceremony around modules, imports, etc. <lang mercury>:- type busy_beaver_states ---> a ; b ; c ; halt.

- type busy_beaver_symbols ---> '0' ; '1'.

- func busy_beaver_config = config(busy_beaver_states, busy_beaver_symbols).

busy_beaver_config = config(a,  % initial state

                           set([halt]), % set of terminating states
                           '0').        % blank symbol

- pred busy_beaver(busy_beaver_states::in,

                   busy_beaver_symbols::in,
                   busy_beaver_symbols::out,
                   action::out,
                   busy_beaver_states::out) is semidet.

busy_beaver(a, '0', '1', right, b). busy_beaver(a, '1', '1', left, c). busy_beaver(b, '0', '1', left, a). busy_beaver(b, '1', '1', right, b). busy_beaver(c, '0', '1', left, b). busy_beaver(c, '1', '1', stay, halt).

TapeOut = turing(busy_beaver_config, busy_beaver, []).</lang> This will, on execution, fill TapeOut with [1, 1, 1, 1, 1, 1].

Prolog

The universal machine

Source for this example was lightly adapted from https://bitbucket.org/ttmrichter/turing. This machine, because of Prolog's dynamic nature, has to check its configuration and the rules' compliance to the same at run-time. This is the role of all but the first of the memberchk/2 predicates. In addition, calling the user-supplied rules has to be wrapped in a once/1 wrapper because there is no way to guarantee in advance that the rules provided are deterministic. (An alternative to doing this is to simply allow perform/5 to be non-deterministic or to check for multiple results and report an error on such.) <lang prolog>turing(Config, Rules, TapeIn, TapeOut) :-

   call(Config, IS, _, _, _, _),
   perform(Config, Rules, IS, {[], TapeIn}, {Ls, Rs}),
   reverse(Ls, Ls1),
   append(Ls1, Rs, TapeOut).

perform(Config, Rules, State, TapeIn, TapeOut) :-

   call(Config, _, FS, RS, B, Symbols),
   ( memberchk(State, FS) ->
       TapeOut = TapeIn
   ; memberchk(State, RS) ->
       {LeftIn, RightIn} = TapeIn,
       symbol(RightIn, Symbol, RightRem, B),
       memberchk(Symbol, Symbols),
       once(call(Rules, State, Symbol, NewSymbol, Action, NewState)),
       memberchk(NewSymbol, Symbols),
       action(Action, {LeftIn, [NewSymbol|RightRem]}, {LeftOut, RightOut}, B),
       perform(Config, Rules, NewState, {LeftOut, RightOut}, TapeOut) ).

symbol([], B, [], B). symbol([Sym|Rs], Sym, Rs, _).

action(left, {Lin, Rin}, {Lout, Rout}, B) :- left(Lin, Rin, Lout, Rout, B). action(stay, Tape, Tape, _). action(right, {Lin, Rin}, {Lout, Rout}, B) :- right(Lin, Rin, Lout, Rout, B).

left([], Rs, [], [B|Rs], B). left([L|Ls], Rs, Ls, [L|Rs], _).

right(L, [], [B|L], [], B). right(L, [S|Rs], [S|L], Rs, _).</lang>

The incrementer machine

<lang prolog>incrementer_config(IS, FS, RS, B, S) :-

   IS = q0,      % initial state
   FS = [qf],    % halting states
   RS = [IS],    % running states
   B  = 0,       % blank symbol
   S  = [B, 1].  % valid symbols

incrementer(q0, 1, 1, right, q0). incrementer(q0, b, 1, stay, qf).

turing(incrementer_config, incrementer, [1, 1, 1], TapeOut).</lang> This will, on execution, fill TapeOut with [1, 1, 1, 1].

The busy beaver machine

<lang prolog>busy_beaver_config(IS, FS, RS, B, S) :-

   IS = 'A',               % initial state
   FS = ['HALT'],          % halting states
   RS = [IS, 'B', 'C'],    % running states
   B  = 0,                 % blank symbol
   S  = [B, 1].            % valid symbols

busy_beaver('A', 0, 1, right, 'B'). busy_beaver('A', 1, 1, left, 'C'). busy_beaver('B', 0, 1, left, 'A'). busy_beaver('B', 1, 1, right, 'B'). busy_beaver('C', 0, 1, left, 'B'). busy_beaver('C', 1, 1, stay, 'HALT').

turing(busy_beaver_config, busy_beaver, [], TapeOut).</lang> This will, on execution, fill TapeOut with [1, 1, 1, 1, 1, 1].

Ruby

The universal machine

<lang ruby>class Turing

   class Tape
       def initialize(symbols, blank, starting_tape)
           @symbols = symbols
           @blank = blank
           @tape = starting_tape
           @index = 0
       end
       def read
           retval = @tape[@index]
           unless retval
               retval = @tape[@index] = @blank
           end
           raise "invalid symbol '#{retval}' on tape" unless @tape.member?(retval)
           return retval
       end
       def write(symbol)
           @tape[@index] = symbol
       end
       def right
           @index += 1
       end
       def left
           if @index == 0
             @tape.unshift @blank
           else
             @index -= 1
           end
       end
       def stay
           # nop
       end
       def get_tape
           return @tape
       end
   end

   def initialize(symbols, blank,
                  initial_state, halt_states, running_states,
                  rules, starting_tape = [])
       @tape = Tape.new(symbols, blank, starting_tape)
       @initial_state = initial_state
       @halt_states = halt_states
       @running_states = running_states
       @rules = rules
       @halted = false
   end
   def run
       raise "machine already halted" if @halted
       state = @initial_state
       while (true)
           break if @halt_states.member? state
           raise "unknown state '#{state}'" unless @running_states.member? state
           symbol = @tape.read
           outsym, action, state = @rules[state][symbol]
           @tape.write outsym
           @tape.send action
       end
       @halted = true
       return @tape.get_tape
   end

end</lang>

The incrementer machine

<lang ruby>incrementer_rules = {

   :q0 => { 1  => [1, :right, :q0],
            :b => [1, :stay,  :qf]}

} t = Turing.new([:b, 1], # permitted symbols

              :b,                # blank symbol
              :q0,               # starting state
              [:qf],             # terminating states
              [:q0],             # running states
              incrementer_rules, # operating rules
              [1, 1, 1])         # starting tape

print t.run, "\n"</lang>

The busy beaver machine

<lang ruby>busy_beaver_rules = {

   :a => { 0 => [1, :right, :b],
           1 => [1, :left,  :c]},
   :b => { 0 => [1, :left,  :a],
           1 => [1, :right, :b]},
   :c => { 0 => [1, :left,  :b],
           1 => [1, :stay,  :halt]}

} t = Turing.new([0, 1], # permitted symbols

              0,                 # blank symbol
              :a,                # starting state
              [:halt],           # terminating states
              [:a, :b, :c],      # running states
              busy_beaver_rules, # operating rules
              [])                # starting tape

print t.run, "\n"</lang>