Universal Turing machine

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
Terminating states: qf
Permissible symbols: B, 1
Blank symbol: B
Rules:
- (q0, 1, 1, right, q0)
- (q0, B, 1, stay, qf)

Three-state busy beaver

States: a, b, c, halt
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).

Prolog

The universal machine

Source for this example was lightly adapted from https://bitbucket.org/ttmrichter/turing. <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].