Universal Turing machine

From Rosetta Code
Task
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.

Ada

The specification of the universal machine

Note that due to Ada's strict type system, a machine cannot be compiled if there is not _exactly_ one rule for each state/symbol pair. Thus, the specified machine is always deterministic.

The execution of the machine, i.e., the procedure Run, allows to define a number Max_Steps, after which the execution stops -- when, e.g., the specified machine runs infinitively. The procedure also allows to optionally output the configuration of the machine before every step.

<lang Ada>private with Ada.Containers.Doubly_Linked_Lists;

generic 

  type State is (<>);   -- State'First is starting state
  type Symbol is (<>);  -- Symbol'First is blank

package Turing is 

  Start: constant State := State'First;
  Halt:  constant State := State'Last;
  subtype Action_State is State range Start .. State'Pred(Halt);

  Blank: constant Symbol := Symbol'First;

  type Movement is (Left, Stay, Right);

  type Action is record
     New_State: State;
     Move_To: Movement;
     New_Symbol: Symbol;
  end record;

  type Rules_Type is array(Action_State, Symbol) of Action;

  type Tape_Type is limited private;

  type Symbol_Map is array(Symbol) of Character;

  function To_String(Tape: Tape_Type; Map: Symbol_Map) return String;
  function Position_To_String(Tape: Tape_Type; Marker: Character := '^')
                             return String;
  function To_Tape(Str: String; Map: Symbol_Map) return Tape_Type;

  procedure Single_Step(Current: in out State;
                        Tape: in out Tape_Type;
                        Rules: Rules_Type);

  procedure Run(The_Tape: in out Tape_Type;
                Rules: Rules_Type;
                Max_Steps: Natural := Natural'Last;
                Print: access procedure(Tape: Tape_Type; Current: State));
  -- runs from Start State until either Halt or # Steps exceeds Max_Steps
  -- if # of steps exceeds Max_Steps, Constrained_Error is raised;
  -- if Print is not null, Print is called at the beginning of each step

private 

  package Symbol_Lists is new Ada.Containers.Doubly_Linked_Lists(Symbol);
  subtype List is Symbol_Lists.List;

  type Tape_Type is record
     Left:  List;
     Here:  Symbol;
     Right: List;
  end record;

end Turing;</lang>

The implementation of the universal machine

<lang Ada>package body Turing is 

  function List_To_String(L: List; Map: Symbol_Map) return String is
     LL: List := L;
     use type List;
  begin
     if L = Symbol_Lists.Empty_List then
        return "";
     else
        LL.Delete_First;
        return Map(L.First_Element) & List_To_String(LL, Map);
     end if;
  end List_To_String;

  function To_String(Tape: Tape_Type; Map: Symbol_Map) return String is

  begin
     return List_To_String(Tape.Left, Map) & Map(Tape.Here) &
       List_To_String(Tape.Right, Map);
  end To_String;

  function Position_To_String(Tape: Tape_Type; Marker: Character := '^')
                             return String is
     Blank_Map: Symbol_Map := (others => ' ');
  begin
     return List_To_String(Tape.Left, Blank_Map) & Marker &
       List_To_String(Tape.Right, Blank_Map);
  end Position_To_String;

  function To_Tape(Str: String; Map: Symbol_Map) return Tape_Type is
     Char_Map: array(Character) of Symbol := (others => Blank);
     Tape: Tape_Type;
  begin
     if Str = "" then
        Tape.Here := Blank;
     else
        for S in Symbol loop
           Char_Map(Map(S)) := S;
        end loop;
        Tape.Here := Char_Map(Str(Str'First));
        for I in Str'First+1 .. Str'Last loop
           Tape.Right.Append(Char_Map(Str(I)));
        end loop;
     end if;
     return Tape;
     end To_Tape;

  procedure Single_Step(Current: in out State;
                        Tape: in out Tape_Type;
                        Rules: Rules_Type) is
     Act: Action := Rules(Current, Tape.Here);
     use type List; -- needed to compare Tape.Left/Right to the Empty_List
  begin
     Current := Act.New_State;     -- 1. update State
     Tape.Here := Act.New_Symbol;  -- 2. write Symbol to Tape
     case Act.Move_To is           -- 3. move Tape to the Left/Right or Stay
        when Left =>
           Tape.Right.Prepend(Tape.Here);
           if Tape.Left /= Symbol_Lists.Empty_List then
              Tape.Here := Tape.Left.Last_Element;
              Tape.Left.Delete_Last;
           else
              Tape.Here := Blank;
           end if;
       when Stay =>
           null; -- Stay where you are!
        when Right =>
           Tape.Left.Append(Tape.Here);
           if Tape.Right /= Symbol_Lists.Empty_List then
              Tape.Here := Tape.Right.First_Element;
              Tape.Right.Delete_First;
           else
              Tape.Here := Blank;
           end if;
     end case;
  end Single_Step;

  procedure Run(The_Tape: in out Tape_Type;
                Rules: Rules_Type;
                Max_Steps: Natural := Natural'Last;
                Print: access procedure (Tape: Tape_Type; Current: State)) is
     The_State: State     := Start;
     Steps:     Natural   := 0;
  begin
     Steps := 0;
     while (Steps <= Max_Steps) and (The_State /= Halt) loop
        if Print /= null then
           Print(The_Tape, The_State);
        end if;
        Steps := Steps + 1;
        Single_Step(The_State, The_Tape, Rules);
     end loop;
     if The_State /= Halt then
        raise Constraint_Error;
     end if;
  end Run;

end Turing;</lang>


The implementation of the simple incrementer

<lang Ada>with Ada.Text_IO, Turing;

procedure Simple_Incrementer is 

  type States is (Start, Stop);
  type Symbols is (Blank, One);

  package UTM is new Turing(States, Symbols);
  use UTM;

  Map: Symbol_Map := (One => '1', Blank => '_');

  Rules: Rules_Type :=
    (Start => (One   => (Start, Right,  One),
               Blank => (Stop,  Stay,  One)));
  Tape:  Tape_Type := To_Tape("111", Map);

  procedure Put_Tape(Tape: Tape_Type; Current: States) is
  begin
    Ada.Text_IO.Put_Line(To_String(Tape, Map) & "  " & States'Image(Current));
    Ada.Text_IO.Put_Line(Position_To_String(Tape));
  end Put_Tape;

begin 

  Run(Tape, Rules, 20, null); -- don't print the configuration during running
  Put_Tape(Tape, Stop);       -- print the final configuration

end Simple_Incrementer;</lang>

Output:
1111  STOP
   ^

The implementation of the busy beaver

<lang Ada>with Ada.Text_IO, Turing;

procedure Busy_Beaver_3 is 

  type States is (A, B, C, Stop);
  type Symbols is range 0 .. 1;
  package UTM is new Turing(States, Symbols); use UTM;

  Map: Symbol_Map := (1 => '1', 0 => '0');

  Rules: Rules_Type :=
    (A => (0 => (New_State => B, Move_To => Right, New_Symbol => 1),
           1 => (New_State => C, Move_To => Left,  New_Symbol => 1)),
     B => (0 => (New_State => A, Move_To => Left,  New_Symbol => 1),
           1 => (New_State => B, Move_To => Right, New_Symbol => 1)),
     C => (0 => (New_State => B, Move_To => Left,  New_Symbol => 1),
           1 => (New_State => Stop, Move_To => Stay, New_Symbol => 1)));

  Tape:  Tape_Type := To_Tape("", Map);

  procedure Put_Tape(Tape: Tape_Type; Current: States) is
  begin
     Ada.Text_IO.Put_Line(To_String(Tape, Map) & "  " &
                            States'Image(Current));
     Ada.Text_IO.Put_Line(Position_To_String(Tape));
  end Put_Tape;

begin 

  Run(Tape, Rules, 20, Put_Tape'Access); -- print configuration before each step
  Put_Tape(Tape, Stop);                  -- and print the final configuration

end Busy_Beaver_3;</lang>

Output:
0  A
^
10  B
 ^
11  A
^
011  C
^
0111  B
^
01111  A
^
11111  B
 ^
11111  B
  ^
11111  B
   ^
11111  B
    ^
111110  B
     ^
111111  A
    ^
111111  C
   ^
111111  STOP
   ^

C++

<lang cpp>

  1. include <vector>
  2. include <string>
  3. include <iostream>
  4. include <algorithm>
  5. include <fstream>
  6. include <iomanip>

//-------------------------------------------------------------------------------------------------- typedef unsigned int uint; using namespace std; const uint TAPE_MAX_LEN = 49152; //-------------------------------------------------------------------------------------------------- struct action { char write, direction; }; //-------------------------------------------------------------------------------------------------- class tape { public: 

   tape( uint startPos = TAPE_MAX_LEN >> 1 ) : MAX_LEN( TAPE_MAX_LEN ) { _sp = startPos; reset(); }
   void reset() { clear( '0' ); headPos = _sp; }
   char read(){ return _t[headPos]; }
   void input( string a ){ if( a == "" ) return; for( uint s = 0; s < a.length(); s++ ) _t[headPos + s] = a[s]; }
   void clear( char c ) {  _t.clear(); blk = c; _t.resize( MAX_LEN, blk ); }
   void action( const action* a ) { write( a->write ); move( a->direction ); }
   void print( int c = 10 ) 
   {

int ml = static_cast<int>( MAX_LEN ), st = static_cast<int>( headPos ) - c, ed = static_cast<int>( headPos ) + c + 1, tx; for( int x = st; x < ed; x++ ) { tx = x; if( tx < 0 ) tx += ml; if( tx >= ml ) tx -= ml; cout << _t[tx]; } cout << endl << setw( c + 1 ) << "^" << endl; 

   }

private: 

   void move( char d ) { if( d == 'N' ) return; headPos += d == 'R' ? 1 : -1; if( headPos >= MAX_LEN ) headPos = d == 'R' ? 0 : MAX_LEN - 1; }
   void write( char a ) { if( a != 'N' ) { if( a == 'B' ) _t[headPos] = blk; else _t[headPos] = a; } }
   string _t; uint headPos, _sp; char blk; const uint MAX_LEN;

}; //-------------------------------------------------------------------------------------------------- class state { public: 

   bool operator ==( const string o ) { return o == name; }
   string name, next; char symbol, write, direction;

}; //-------------------------------------------------------------------------------------------------- class actionTable { public: 

   bool loadTable( string file )
   {

reset(); ifstream mf; mf.open( file.c_str() ); if( mf.is_open() ) { string str; state stt; while( mf.good() ) { getline( mf, str ); if( str[0] == '\ ) break; parseState( str, stt ); states.push_back( stt ); } while( mf.good() ) { getline( mf, str ); if( str == "" ) continue; if( str[0] == '!' ) blank = str.erase( 0, 1 )[0]; if( str[0] == '^' ) curState = str.erase( 0, 1 ); if( str[0] == '>' ) input = str.erase( 0, 1 ); } mf.close(); return true; } cout << "Could not open " << file << endl; return false; 

   }

   bool action( char symbol, action& a )
   {

vector<state>::iterator f = states.begin(); while( true ) { f = find( f, states.end(), curState ); if( f == states.end() ) return false; if( ( *f ).symbol == '*' || ( *f ).symbol == symbol || ( ( *f ).symbol == 'B' && blank == symbol ) ) { a.direction = ( *f ).direction; a.write = ( *f ).write; curState = ( *f ).next; break; } f++; } return true; 

   }
   void reset() { states.clear(); blank = '0'; curState = input = ""; }
   string getInput() { return input; }
   char getBlank() { return blank; }

private: 

   void parseState( string str, state& stt )
   {

string a[5]; int idx = 0; for( string::iterator si = str.begin(); si != str.end(); si++ ) { if( ( *si ) == ';' ) idx++; else a[idx].append( &( *si ), 1 ); } stt.name = a[0]; stt.symbol = a[1][0]; stt.write = a[2][0]; stt.direction = a[3][0]; stt.next = a[4]; 

   }
   vector<state> states; char blank; string curState, input;

}; //-------------------------------------------------------------------------------------------------- class utm { public: 

   utm() { files[0] = "incrementer.utm"; files[1] = "busy_beaver.utm"; files[2] = "sort.utm"; }
   void start()
   {

while( true ) { reset(); int t = showMenu(); if( t == 0 ) return; if( !at.loadTable( files[t - 1] ) ) return; startMachine(); } 

   }

private: 

   void simulate()
   {

char r; action a; while( true ) { tp.print(); r = tp.read(); if( !( at.action( r, a ) ) ) break; tp.action( &a ); } cout << endl << endl; system( "pause" ); 

   }

   int showMenu()
   {

int t = -1; while( t < 0 || t > 3 ) { system( "cls" ); cout << "1. Incrementer\n2. Busy beaver\n3. Sort\n\n0. Quit"; cout << endl << endl << "Choose an action "; cin >> t; } return t; 

   }

   void reset() { tp.reset(); at.reset(); }
   void startMachine() { system( "cls" ); tp.clear( at.getBlank() ); tp.input( at.getInput() ); simulate(); }

   tape tp; actionTable at; string files[7];

}; //-------------------------------------------------------------------------------------------------- int main( int a, char* args[] ){ utm mm; mm.start(); return 0; } //-------------------------------------------------------------------------------------------------- </lang>

These are the files you'll need
File explanation:
Each line contains one tuple of the form '<current state> <current symbol> <new symbol> <direction> <new state>
B = blank, H = halt, N = do nothing, * matches any current symbol
' = marks the end of the action table
! = blank symbol => eg: !0 => 0 is the blank symbol
^ starting state
> input

Incrementer

q0;1;1;R;q0
q0;B;1;H;qf
'
!0
^q0
>111

Busy beaver

A;0;1;R;B
A;1;1;L;C
B;0;1;L;A
B;1;1;R;B
C;0;1;L;B
C;1;1;N;H
'
!0
^A

Sort

A;1;1;R;A
A;2;3;R;B
A;0;0;L;E
B;1;1;R;B
B;2;2;R;B
B;0;0;L;C
C;1;2;L;D
C;2;2;L;C
C;3;2;L;E
D;1;1;L;D
D;2;2;L;D
D;3;1;R;A
E;1;1;L;E
E;0;0;R;H
'
!0
^A
>1221221211
Output:

Busy beaver 

000000000000000000000
          ^
000000000100000000000
          ^
000000000011000000000
          ^
000000000001100000000
          ^
000000000001110000000
          ^
000000000001111000000
          ^
000000000111110000000
          ^
000000001111100000000
          ^
000000011111000000000
          ^
000000111110000000000
          ^
000001111100000000000
          ^
000000111111000000000
          ^
000000011111100000000
          ^
000000011111100000000
          ^

D

This is typed less strongly than the Ada entry. The constructor of UTM contains many run-time tests that in a strongly static typed version are (implicitly) done at compile-time. <lang d>import std.stdio, std.algorithm, std.string, std.conv, std.array, 

      std.exception;

struct UTM(bool doShow=true) { 

   alias Symbol = uint;
   alias State = char; // Typedef?
   enum Direction { right, left, stay }

   private TapeHead head;
   private const TuringMachine tm;

   static struct Rule {
       Symbol toWrite;
       Direction direction;
       State nextState;
   }

   static struct TuringMachine {
       Symbol[] symbols;
       Symbol blank;
       State initialState;
       State[] haltStates, runningStates;
       Rule[Symbol][State] rules;
       Symbol[] input;
   }

   static struct TapeHead {
       immutable Symbol blank;
       Symbol[] tape;
       size_t position;

       this(in ref TuringMachine t) pure /*nothrow*/ {
           this.blank = t.blank;
           this.tape = t.input.dup; // Not nothrow.
           if (this.tape.empty)
               this.tape = [this.blank];
           this.position = 0;
       }

       pure nothrow invariant() {
           assert(this.position < this.tape.length);
       }

       Symbol read() const pure nothrow {
           return this.tape[this.position];
       }

       void show() const {
           .write(this);
       }

       void write(in Symbol symbol) {
           static if (doShow)
               show();
           this.tape[this.position] = symbol;
       }

       void right() pure nothrow {
           this.position++;
           if (this.position == this.tape.length)
               this.tape ~= this.blank;
       }

       void left() pure nothrow {
           if (this.position == 0)
               this.tape = this.blank ~ this.tape;
           else
               this.position--;
       }

       void move(in Direction dir) {
           final switch (dir) {
               case Direction.left:  left();         break;
               case Direction.right: right();        break;
               case Direction.stay:  /*Do nothing.*/ break;
           }
       }

       string toString() const {
           return format("...%(%)...", this.tape)
                  ~ '\n'
                  ~ format("%" ~ text(this.position + 4) ~ "s", "^")
                  ~ '\n';
       }
   }

   void show() const {
       head.show();
   }

   this(const ref TuringMachine tm_) {
       immutable errMsg = "Invalid input.";
       enforce(!tm_.runningStates.empty, errMsg);
       enforce(!tm_.haltStates.empty, errMsg);
       enforce(!tm_.symbols.empty, errMsg);
       enforce(tm_.rules.length, errMsg);
       enforce(tm_.runningStates.canFind(tm_.initialState), errMsg);
       enforce(tm_.symbols.canFind(tm_.blank), errMsg);
       const allStates = tm_.runningStates ~ tm_.haltStates;
       foreach (const s; tm_.rules.keys.to!(dchar[])().sort())
           enforce(tm_.runningStates.canFind(s), errMsg);
       foreach (const aa; tm_.rules.byValue)
           foreach (/*const*/ s, const rule; aa) {
               enforce(tm_.symbols.canFind(s), errMsg);
               enforce(tm_.symbols.canFind(rule.toWrite), errMsg);
               enforce(allStates.canFind(rule.nextState), errMsg);
           }

       this.tm = tm_;
       this.head = TapeHead(this.tm);

       State state = this.tm.initialState;
       while (true) {
           if (tm.haltStates.canFind(state))
               break;
           if (!tm.runningStates.canFind(state))
               throw new Exception("Unknown state.");
           immutable symbol = this.head.read();
           immutable rule = this.tm.rules[state][symbol];
           this.head.write(rule.toWrite);
           this.head.move(rule.direction);
           state = rule.nextState;
       }
       static if (doShow)
           show();
   }

}

void main() { 

   with (UTM!()) {
       alias R = Rule;
       writeln("Incrementer:");
       TuringMachine tm1;
       tm1.symbols = [0, 1];
       tm1.blank = 0;
       tm1.initialState = 'A';
       tm1.haltStates = ['H'];
       tm1.runningStates = ['A'];
       with (Direction)
           tm1.rules = ['A': [0: R(1, left,  'H'),
                              1: R(1, right, 'A')]];
       tm1.input = [1, 1, 1];
       UTM!()(tm1);

       // http://en.wikipedia.org/wiki/Busy_beaver
       writeln("\nBusy beaver machine (3-state, 2-symbol):");
       TuringMachine tm2;
       tm2.symbols = [0, 1];
       tm2.blank = 0;
       tm2.initialState = 'A';
       tm2.haltStates = ['H'];
       tm2.runningStates = ['A', 'B', 'C'];
       with (Direction)
           tm2.rules = ['A': [0: R(1, right, 'B'),
                              1: R(1, left,  'C')],
                        'B': [0: R(1, left,  'A'),
                              1: R(1, right, 'B')],
                        'C': [0: R(1, left,  'B'),
                              1: R(1, stay,  'H')]];
       UTM!()(tm2);
   }

   with (UTM!false) {
       writeln("\nSorting stress test (12212212121212):");
       alias R = Rule;
       TuringMachine tm3;
       tm3.symbols = [0, 1, 2, 3];
       tm3.blank = 0;
       tm3.initialState = 'A';
       tm3.haltStates = ['H'];
       tm3.runningStates = ['A', 'B', 'C', 'D', 'E'];
       with (Direction)
           tm3.rules = ['A': [1: R(1, right, 'A'),
                              2: R(3, right, 'B'),
                              0: R(0, left,  'E')],
                        'B': [1: R(1, right, 'B'),
                              2: R(2, right, 'B'),
                              0: R(0, left,  'C')],
                        'C': [1: R(2, left,  'D'),
                              2: R(2, left,  'C'),
                              3: R(2, left,  'E')],
                        'D': [1: R(1, left,  'D'),
                              2: R(2, left,  'D'),
                              3: R(1, right, 'A')],
                        'E': [1: R(1, left,  'E'),
                              0: R(0, right, 'H')]];
       tm3.input = [1, 2, 2, 1, 2, 2, 1, 2, 1, 2, 1, 2, 1, 2];
       UTM!false(tm3).show();
   }

}</lang>

Output:
Incrementer:
...111...
   ^
...111...
    ^
...111...
     ^
...1110...
      ^
...1111...
     ^

Busy beaver machine (3-state, 2-symbol):
...0...
   ^
...10...
    ^
...11...
   ^
...011...
   ^
...0111...
   ^
...01111...
   ^
...11111...
    ^
...11111...
     ^
...11111...
      ^
...11111...
       ^
...111110...
        ^
...111111...
       ^
...111111...
      ^
...111111...
      ^

Sorting stress test (12212212121212):
...0111111222222220...
    ^

Erlang

The following code is an Escript which can be placed into a file and run as escript filename or simply marked as executable and run directly via the provided shebang header. -type and -spec declarations have not been used; using the typer utility can get a head start on this process should a more robust solution be desired.

In this universal Turing machine simulator, a machine is defined by giving it a configuration function that returns the initial state, the halting states and the blank symbol, as well as a function for the rules. These are passed in to the public interface turing/3 as funs, together with the initial tape setup.

<lang erlang>#!/usr/bin/env escript

-module(turing). -mode(compile).

-export([main/1]).

% Incrementer definition: % States: a | halt % Initial state: a % Halting states: halt % Symbols: b | '1' % Blank symbol: b incrementer_config() -> {a, [halt], b}. incrementer(a, '1') -> {'1', right, a}; incrementer(a, b) -> {'1', stay, halt}.

% Busy beaver definition: % States: a | b | c | halt % Initial state: a % Halting states: halt % Symbols: '0' | '1' % Blank symbol: '0' busy_beaver_config() -> {a, [halt], '0'}. 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}.

% Mainline code. main([]) -> 

   io:format("==============================~n"),
   io:format("Turing machine simulator test.~n"),
   io:format("==============================~n"),

   Tape1 = turing(fun incrementer_config/0, fun incrementer/2, ['1','1','1']),
   io:format("~w~n", [Tape1]),

   Tape2 = turing(fun busy_beaver_config/0, fun busy_beaver/2, []),
   io:format("~w~n", [Tape2]).

% Universal Turing machine simulator. turing(Config, Rules, Input) -> 

   {Start, _, _} = Config(),
   {Left, Right} = perform(Config, Rules, Start, {[], Input}),
   lists:reverse(Left) ++ Right.

perform(Config, Rules, State, Input = {LeftInput, RightInput}) -> 

   {_, Halts, Blank} = Config(),
   case lists:member(State, Halts) of
       true  -> Input;
       false ->
           {NewRight, Symbol} = symbol(RightInput, Blank),
           {NewSymbol, Action, NewState} = Rules(State, Symbol),
           NewInput = action(Action, Blank, {LeftInput, [NewSymbol| NewRight]}),
           perform(Config, Rules, NewState, NewInput)
   end.

symbol([], Blank) -> {[], Blank}; symbol([S|R], _) -> {R, S}.

action(left, Blank, {[], Right}) -> {[], [Blank|Right]}; action(left, _, {[L|Ls], Right}) -> {Ls, [L|Right]}; action(stay, _, Tape) -> Tape; action(right, Blank, {Left, []}) -> {[Blank|Left], []}; action(right, _, {Left, [R|Rs]}) -> {[R|Left], Rs}.</lang>

J

Source for this task was slightly adapted from http://www.2bestsystems.com/j/J_Conference_2012. All the information for the Turing machines is represented by integers, the halting state is set as _1 (minus one), and head movements are mapped as (left, stay, right) ➜ (_1, 0, 1). A Turing machine is executed until a halt state is issued or a trivial infinite regress in the form of a single changeless cycle is detected. The transition table entry format is similar to the one in http://drb9.drb.insel.de/~heiner/BB/simAB3Y_SB.html.

The universal Turing machine

The universal Turing machine is defined in terms of the fixed tacit (stateless point-free) code, showing that this dialect of J is Turing complete. <lang j> ".@(('utm=. '),,)@(];._2)@(noun=. ".@('(0 : 0)'"_))_ NB. Fixed tacit universal Turing machine code...

(((":@:(]&:>)@:(6&({::)) ,: (":@] 9&({::))) ,. ':'"_) ,. 2&({::) >@:((( 48 + ]) { a."_)@[ ; (] $ ' '"_) , '^'"_) 3&({::))@:([ (0 0 $ 1!:2&2)@:( 'A changeless cycle was detected!'"_)^:(-.@:(_1"_ = 1&({::))))@:((((3&( {::) + 8&({::)) ; 1 + 9&({::)) 3 9} ])@:(<@:((0: 0&({::)@]`(<@(1&({::)) @])`(2&({::)@])} ])@:(7 3 2&{)) 2} ])@:(<"0@:(6&({::) (<@[ { ]) 0&({::) ) 7 8 1} ])@:([ (0 0 $ 1!:2&2)@:(((":@:(]&:>)@:(6&({::)) ,: (":@] 9&({:

))) ,. ':'"_) ,. 2&({::) >@:(((48 + ]) { a."_)@[ ; (] $ ' '"_) , '^'"_

) 3&({::))^:(0 = 4&({::) | 9&({::)))@:(<@:(1&({::) ; 3&({::) { 2&({::)) 

6} ])@:(<@:(3&({::) + _1 = 3&({::)) 3} ])@:(<@:(((_1 = 3&({::)) {:: 5&

({::)) , 2&({::) , (3&({::) = #@:(2&({::))) {:: 5&({::)) 2} ])^:(-.@:(_ 1"_ = 1&({::)))^:_)@:((0 ; (({. , ({: % 3:) , 3:)@:$ $ ,)@:(}."1)@:(".; ._2)@:(0&({::))) 9 0} ])@:(<@:( ; 0"_) 5} ])@:(5&(] , a: $~ [))@:(,~)

)</lang>

The incrementer machine

<lang j> NB. Simple Incrementer... 

  NB.        0         1     Tape Symbol Scan
  NB. S   p  m  g   p  m  g  (p,m,g) → (print,move,goto)
  QS=. (noun _) ; 0          NB. Reading the transition table and setting the initial state
      0   1  0 _1   1  1  0

) 

  TPF=. 1 1 1 ; 0 ; 1        NB. Setting the tape, its pointer and the display frequency
  
  TPF utm QS                 NB. Running the Turing machine...

0 1:111 0  :^ 0 1:111 1  : ^ 0 1:111 2  : ^ 0 0:1110 3  : ^ 0 0:1111 4  : ^</lang>

The three-state busy beaver machine

<lang j> NB. Three-state busy beaver.. 

  NB.        0         1     Tape Symbol Scan
  NB. S   p  m  g   p  m  g  (p,m,g) → (print,move,goto)
  QS=. (noun _) ; 0          NB. Reading the transition table and setting the initial state
      0   1  1  1   1 _1  2
      1   1 _1  0   1  1  1
      2   1 _1  1   1  0 _1

) 

  TPF=. 0 ; 0 ; 1            NB. Setting the tape, its pointer and the display frequency
  
  TPF utm QS                 NB. Running the Turing machine...

0 0:0 0  :^ 1 0:10 1  : ^ 0 1:11 2  :^ 2 0:011 3  :^ 1 0:0111 4  :^ 0 0:01111 5  :^ 1 1:11111 6  : ^ 1 1:11111 7  : ^ 1 1:11111 8  : ^ 1 1:11111 9  : ^ 1 0:111110 10 : ^ 0 1:111111 11 : ^ 2 1:111111 12 : ^ 2 1:111111 13 : ^</lang>

The sorting stress test machine

<lang j> NB. Sorting stress test... 

  NB.        0         1         2         3     Tape Symbol Scan
  NB. S   p  m  g   p  m  g   p  m  g   p  m  g  (p,m,g) ➜ (print,move,goto)
  QS=. (noun _) ; 0          NB. Reading the transition table and setting the initial state
      0   0 _1  4   1  1  0   3  1  1   _  _  _
      1   0 _1  2   1  1  1   2  1  1   _  _  _
      2   _  _  _   2 _1  3   2 _1  2   2 _1  4
      3   _  _  _   1 _1  3   2 _1  3   1  1  0
      4   0  1 _1   1 _1  4   _  _  _   _  _  _

) 

  TPF=. 1 2 2 1 2 2 1 2 1 2 1 2 1 2 ; 0 ; 50   NB. Setting the tape, its pointer and the display frequency
  
  TPF utm QS                 NB. Running the Turing machine...

0 1:12212212121212 0  :^ 3 2:113122121222220 50 : ^ 1 2:111111322222220 100: ^ 4 0:0111111222222220 118: ^</lang>

The structured derivation of the universal Turing machine

The fixed tacit code was produced as follows: <lang j> NB. Structured derivation of the universal Turing machine... 

  o=. @:        NB. Composition of verbs (functions) 
  c=. "_        NB. Constant verb (function)
  f=. &{::      NB. fetch
  e=. <@:       NB. enclose
  
  NB. utm (dyadic verb)...
  
  'Q S T P F B M PRINT MOVE C'=. i.10 NB. Using 10 boxes
    NB. Left:  Q     - Instruction table,  S - Turing machine state
    NB. Right: T     - Data tape,          P - Head position pointer,       F     - Display frequency
    NB. Local: B     - Blank defaults,     M - State and tape symbol read,  PRINT - Printing symbol 
    NB.        MOVE  - Tape head moving instruction,                        C     - Step Counter 
     
  DisplayTape=. > o (((48 + ]) { a.c)@[ ; ((] $ ' 'c) , '^'c))
  display=. ((((": o (]&:>) o (M f)) ,: (":@] C f)) ,. ':'c ) ,. (T f DisplayTape P f))
    NB. Displaying state, symbol, tape / step and pointer
  amend=. 0: (0 f)@]`(<@(1 f)@])`(2 f@])} ]
  
  NB. execute (monadic verb)...
     
  FillLeft=.  (_1   = P f      ) {:: B f      NB. Expanding and filling the tape
  FillRight=. ( P f = # o (T f)) {:: B f      NB. with 0's (if necessary)
  ia=. <@[ { ]                                NB. Selecting by the indices of an array
     
  e0=. (FillLeft , T f , FillRight)e T}]      NB. Adjusting the tape
  e1=. (P f + _1 = P f)e P}]                  NB. and the pointer (if necessary)
  e2=. (S f ; P f { T f)e M}]                 NB. Updating the state and reading the tape symbol 
  e3=. [(smoutput o display)^:(0 = F f | C f) NB. Displaying intermediate cycles		       	
  e4=. (<"0 o (M f ia Q f)) (PRINT,MOVE,S)}]  NB. Performing the printing, moving and state actions
  e5=. (amend o ((PRINT,P,T)&{))e T}]         NB. Printing symbol on tape at the pointer position
  e6=. ((P f + MOVE f) ; 1 + C f) (P,C)}]     NB. Updating the pointer (and the counter)
  
  execute=. e6 o e5 o e4 o e3 o e2 o e1 o e0
  
  al=. &(] , (a: $~ [))                       NB. Appending local boxes
  cc=. 'A changeless cycle was detected!'c
  halt=. _1 c = S f                           NB. Halting when the current state is _1
  rt=. ((({. , ({: % 3:) , 3:) o $) $ ,) o (}."1) o (". ;. _2)
    NB. Reshaping the transition table as a 3D array (state,symbol,action)
     
  m0=. ,~                                     NB. Dyadic form (e.g., TPF f TuringMachine QS f )
  m1=. 5 al                                   NB. Appending 5 local boxes (B,M,PRINT,MOVE,C)
  m2=. ( ; 0 c)e B}]                        NB. Initializing local B (empty defaults as 0)
  m3=. (0 ; rt o (Q f)) (C,Q)}]               NB. Setting (the counter and) the transition table
  m4=. execute^:(-. o halt)^:_                NB. Executing until a halt instruction is issued
  m5=. [smoutput o cc ^: (-. o halt)          NB. or a changeless single cycle is detected
  m6=. display                                NB. Displaying (returning) the final status
     
  utm=. m6 o m5 o m4 o m3 o m2 o m1 o m0 f.   NB. Fixing the universal Turing machine code
  
  lr=. 5!:5@< NB. Linear representation
  
  q: o $      o lr'utm'                       NB. The fixed tacit code length factors

2 2 3 71 

  (12 71 $ ]) o lr'utm'                       NB. The fixed tacit code...

(((":@:(]&:>)@:(6&({::)) ,: (":@] 9&({::))) ,. ':'"_) ,. 2&({::) >@:((( 48 + ]) { a."_)@[ ; (] $ ' '"_) , '^'"_) 3&({::))@:([ (0 0 $ 1!:2&2)@:( 'A changeless cycle was detected!'"_)^:(-.@:(_1"_ = 1&({::))))@:((((3&( {::) + 8&({::)) ; 1 + 9&({::)) 3 9} ])@:(<@:((0: 0&({::)@]`(<@(1&({::)) @])`(2&({::)@])} ])@:(7 3 2&{)) 2} ])@:(<"0@:(6&({::) (<@[ { ]) 0&({::) ) 7 8 1} ])@:([ (0 0 $ 1!:2&2)@:(((":@:(]&:>)@:(6&({::)) ,: (":@] 9&({:

))) ,. ':'"_) ,. 2&({::) >@:(((48 + ]) { a."_)@[ ; (] $ ' '"_) , '^'"_

) 3&({::))^:(0 = 4&({::) | 9&({::)))@:(<@:(1&({::) ; 3&({::) { 2&({::)) 

6} ])@:(<@:(3&({::) + _1 = 3&({::)) 3} ])@:(<@:(((_1 = 3&({::)) {:: 5&

({::)) , 2&({::) , (3&({::) = #@:(2&({::))) {:: 5&({::)) 2} ])^:(-.@:(_ 1"_ = 1&({::)))^:_)@:((0 ; (({. , ({: % 3:) , 3:)@:$ $ ,)@:(}."1)@:(".; ._2)@:(0&({::))) 9 0} ])@:(<@:( ; 0"_) 5} ])@:(5&(] , a: $~ [))@:(,~)</lang>

Java

Works with: Java version 5+

This is an implementation of the universal Turing machine in plain Java using standard libraries only. As generics are used, Java 5 is required. The examples (incrementer and busy beaver) are implemented directly in the main method and executed sequentially. During execution the complete tape and the current active transition are printed out in every step. The state names and tape symbols may contain several characters, so arbitrary strings such as "q1", "q2", ... can be valid state names or tape symbols. The machine is deterministic as the transitions are stored in a HashMap which uses state / tape symbol pairs as keys. This is self-coded, not a standard implementation, so there is no guarantee of correctness.

<lang Java5>import java.util.HashMap; import java.util.HashSet; import java.util.LinkedList; import java.util.ListIterator; import java.util.List; import java.util.Set; import java.util.Map;

public class UTM { 

   private List<String> tape;
   private String blankSymbol;
   private ListIterator<String> head;
   private Map<StateTapeSymbolPair, Transition> transitions = new HashMap<StateTapeSymbolPair, Transition>();
   private Set<String> terminalStates;
   private String initialState;
   
   public UTM(Set<Transition> transitions, Set<String> terminalStates, String initialState, String blankSymbol) {
       this.blankSymbol = blankSymbol;
       for (Transition t : transitions) {
           this.transitions.put(t.from, t);
       }
       this.terminalStates = terminalStates;
       this.initialState = initialState;
   }
   
   public static class StateTapeSymbolPair {
       private String state;
       private String tapeSymbol;

       public StateTapeSymbolPair(String state, String tapeSymbol) {
           this.state = state;
           this.tapeSymbol = tapeSymbol;
       }

       // These methods can be auto-generated by Eclipse.
       @Override
       public int hashCode() {
           final int prime = 31;
           int result = 1;
           result = prime * result
                   + ((state == null) ? 0 : state.hashCode());
           result = prime
                   * result
                   + ((tapeSymbol == null) ? 0 : tapeSymbol
                           .hashCode());
           return result;
       }

       // These methods can be auto-generated by Eclipse.
       @Override
       public boolean equals(Object obj) {
           if (this == obj)
               return true;
           if (obj == null)
               return false;
           if (getClass() != obj.getClass())
               return false;
           StateTapeSymbolPair other = (StateTapeSymbolPair) obj;
           if (state == null) {
               if (other.state != null)
                   return false;
           } else if (!state.equals(other.state))
               return false;
           if (tapeSymbol == null) {
               if (other.tapeSymbol != null)
                   return false;
           } else if (!tapeSymbol.equals(other.tapeSymbol))
               return false;
           return true;
       }

       @Override
       public String toString() {
           return "(" + state + "," + tapeSymbol + ")";
       }
   }
   
   public static class Transition {
       private StateTapeSymbolPair from;
       private StateTapeSymbolPair to;
       private int direction; // -1 left, 0 neutral, 1 right.

       public Transition(StateTapeSymbolPair from, StateTapeSymbolPair to, int direction) {
            this.from = from;
           this.to = to;
           this.direction = direction;
       }

       @Override
       public String toString() {
           return from + "=>" + to + "/" + direction;
       }
   }
   
   public void initializeTape(List<String> input) { // Arbitrary Strings as symbols.
       tape = input;
   }
   
   public void initializeTape(String input) { // Uses single characters as symbols.
       tape = new LinkedList<String>();
       for (int i = 0; i < input.length(); i++) {
           tape.add(input.charAt(i) + "");
       }
   }
   
   public List<String> runTM() { // Returns null if not in terminal state.
       if (tape.size() == 0) {
           tape.add(blankSymbol);
       }
       
       head = tape.listIterator();
       head.next();
       head.previous();
       
       StateTapeSymbolPair tsp = new StateTapeSymbolPair(initialState, tape.get(0));
       
       while (transitions.containsKey(tsp)) { // While a matching transition exists.
           System.out.println(this + " --- " + transitions.get(tsp));
           Transition trans = transitions.get(tsp);
           head.set(trans.to.tapeSymbol); // Write tape symbol.
           tsp.state = trans.to.state; // Change state.
           if (trans.direction == -1) { // Go left.
               if (!head.hasPrevious()) {
                   head.add(blankSymbol); // Extend tape.
               }
               tsp.tapeSymbol = head.previous(); // Memorize tape symbol.
           } else if (trans.direction == 1) { // Go right.
               head.next();
               if (!head.hasNext()) {
                   head.add(blankSymbol); // Extend tape.
                   head.previous();
               }
               tsp.tapeSymbol = head.next(); // Memorize tape symbol.
               head.previous();
           } else {
               tsp.tapeSymbol = trans.to.tapeSymbol;
           }
       }
       
       System.out.println(this + " --- " + tsp);
       
       if (terminalStates.contains(tsp.state)) {
           return tape;
       } else {
           return null;
       }
   }

   @Override
   public String toString() {
       try {
       	int headPos = head.previousIndex();
           String s = "[ ";
           
           for (int i = 0; i <= headPos; i++) {
               s += tape.get(i) + " ";
           }

           s += "[H] ";
           
           for (int i = headPos + 1; i < tape.size(); i++) {
               s += tape.get(i) + " ";
           }

           return s + "]";
       } catch (Exception e) {
           return "";
       }
   }
   
   public static void main(String[] args) {
       // Simple incrementer.
       String init = "q0";
       String blank = "b";
       
       Set<String> term = new HashSet<String>();
       term.add("qf");
       
       Set<Transition> trans = new HashSet<Transition>();
       
       trans.add(new Transition(new StateTapeSymbolPair("q0", "1"), new StateTapeSymbolPair("q0", "1"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("q0", "b"), new StateTapeSymbolPair("qf", "1"), 0));
       
       UTM machine = new UTM(trans, term, init, blank);
       machine.initializeTape("111");
       System.out.println("Output (si): " + machine.runTM() + "\n");
       
       // Busy Beaver (overwrite variables from above).
       init = "a";
       
       term.clear();
       term.add("halt");
       
       blank = "0";
       
       trans.clear();

       // Change state from "a" to "b" if "0" is read on tape, write "1" and go to the right. (-1 left, 0 nothing, 1 right.)
       trans.add(new Transition(new StateTapeSymbolPair("a", "0"), new StateTapeSymbolPair("b", "1"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("a", "1"), new StateTapeSymbolPair("c", "1"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("b", "0"), new StateTapeSymbolPair("a", "1"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("b", "1"), new StateTapeSymbolPair("b", "1"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("c", "0"), new StateTapeSymbolPair("b", "1"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("c", "1"), new StateTapeSymbolPair("halt", "1"), 0));
       
       machine = new UTM(trans, term, init, blank);
       machine.initializeTape("");
       System.out.println("Output (bb): " + machine.runTM());

       // Sorting test (overwrite variables from above).
       init = "s0";
       blank = "*";
       
       term = new HashSet<String>();
       term.add("see");
       
       trans = new HashSet<Transition>();
       
       trans.add(new Transition(new StateTapeSymbolPair("s0", "a"), new StateTapeSymbolPair("s0", "a"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("s0", "b"), new StateTapeSymbolPair("s1", "B"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("s0", "*"), new StateTapeSymbolPair("se", "*"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s1", "a"), new StateTapeSymbolPair("s1", "a"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("s1", "b"), new StateTapeSymbolPair("s1", "b"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("s1", "*"), new StateTapeSymbolPair("s2", "*"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s2", "a"), new StateTapeSymbolPair("s3", "b"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s2", "b"), new StateTapeSymbolPair("s2", "b"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s2", "B"), new StateTapeSymbolPair("se", "b"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s3", "a"), new StateTapeSymbolPair("s3", "a"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s3", "b"), new StateTapeSymbolPair("s3", "b"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("s3", "B"), new StateTapeSymbolPair("s0", "a"), 1));
       trans.add(new Transition(new StateTapeSymbolPair("se", "a"), new StateTapeSymbolPair("se", "a"), -1));
       trans.add(new Transition(new StateTapeSymbolPair("se", "*"), new StateTapeSymbolPair("see", "*"), 1));

       machine = new UTM(trans, term, init, blank);
       machine.initializeTape("babbababaa");
       System.out.println("Output (sort): " + machine.runTM() + "\n");
   }

}</lang>

Output:
[ [H] 1 1 1 ] --- (q0,1)=>(q0,1)/1
[ 1 [H] 1 1 ] --- (q0,1)=>(q0,1)/1
[ 1 1 [H] 1 ] --- (q0,1)=>(q0,1)/1
[ 1 1 1 [H] b ] --- (q0,b)=>(qf,1)/0
[ 1 1 1 [H] 1 ] --- (qf,1)
Output (si): [1, 1, 1, 1]

[ [H] 0 ] --- (a,0)=>(b,1)/1
[ 1 [H] 0 ] --- (b,0)=>(a,1)/-1
[ [H] 1 1 ] --- (a,1)=>(c,1)/-1
[ [H] 0 1 1 ] --- (c,0)=>(b,1)/-1
[ [H] 0 1 1 1 ] --- (b,0)=>(a,1)/-1
[ [H] 0 1 1 1 1 ] --- (a,0)=>(b,1)/1
[ 1 [H] 1 1 1 1 ] --- (b,1)=>(b,1)/1
[ 1 1 [H] 1 1 1 ] --- (b,1)=>(b,1)/1
[ 1 1 1 [H] 1 1 ] --- (b,1)=>(b,1)/1
[ 1 1 1 1 [H] 1 ] --- (b,1)=>(b,1)/1
[ 1 1 1 1 1 [H] 0 ] --- (b,0)=>(a,1)/-1
[ 1 1 1 1 [H] 1 1 ] --- (a,1)=>(c,1)/-1
[ 1 1 1 [H] 1 1 1 ] --- (c,1)=>(halt,1)/0
[ 1 1 1 [H] 1 1 1 ] --- (halt,1)
Output (bb): [1, 1, 1, 1, 1, 1]

[ [H] b a b b a b a b a a ] --- (s0,b)=>(s1,B)/1
[ B [H] a b b a b a b a a ] --- (s1,a)=>(s1,a)/1
[ B a [H] b b a b a b a a ] --- (s1,b)=>(s1,b)/1
[ B a b [H] b a b a b a a ] --- (s1,b)=>(s1,b)/1
[ B a b b [H] a b a b a a ] --- (s1,a)=>(s1,a)/1
[ B a b b a [H] b a b a a ] --- (s1,b)=>(s1,b)/1
[ B a b b a b [H] a b a a ] --- (s1,a)=>(s1,a)/1
[ B a b b a b a [H] b a a ] --- (s1,b)=>(s1,b)/1
[ B a b b a b a b [H] a a ] --- (s1,a)=>(s1,a)/1
[ B a b b a b a b a [H] a ] --- (s1,a)=>(s1,a)/1
[ B a b b a b a b a a [H] * ] --- (s1,*)=>(s2,*)/-1
[ B a b b a b a b a [H] a * ] --- (s2,a)=>(s3,b)/-1
[ B a b b a b a b [H] a b * ] --- (s3,a)=>(s3,a)/-1
[ B a b b a b a [H] b a b * ] --- (s3,b)=>(s3,b)/-1
[ B a b b a b [H] a b a b * ] --- (s3,a)=>(s3,a)/-1
[ B a b b a [H] b a b a b * ] --- (s3,b)=>(s3,b)/-1
[ B a b b [H] a b a b a b * ] --- (s3,a)=>(s3,a)/-1
[ B a b [H] b a b a b a b * ] --- (s3,b)=>(s3,b)/-1
[ B a [H] b b a b a b a b * ] --- (s3,b)=>(s3,b)/-1
[ B [H] a b b a b a b a b * ] --- (s3,a)=>(s3,a)/-1
[ [H] B a b b a b a b a b * ] --- (s3,B)=>(s0,a)/1
[ a [H] a b b a b a b a b * ] --- (s0,a)=>(s0,a)/1
[ a a [H] b b a b a b a b * ] --- (s0,b)=>(s1,B)/1
[ a a B [H] b a b a b a b * ] --- (s1,b)=>(s1,b)/1
[ a a B b [H] a b a b a b * ] --- (s1,a)=>(s1,a)/1
[ a a B b a [H] b a b a b * ] --- (s1,b)=>(s1,b)/1
[ a a B b a b [H] a b a b * ] --- (s1,a)=>(s1,a)/1
[ a a B b a b a [H] b a b * ] --- (s1,b)=>(s1,b)/1
[ a a B b a b a b [H] a b * ] --- (s1,a)=>(s1,a)/1
[ a a B b a b a b a [H] b * ] --- (s1,b)=>(s1,b)/1
[ a a B b a b a b a b [H] * ] --- (s1,*)=>(s2,*)/-1
[ a a B b a b a b a [H] b * ] --- (s2,b)=>(s2,b)/-1
[ a a B b a b a b [H] a b * ] --- (s2,a)=>(s3,b)/-1
[ a a B b a b a [H] b b b * ] --- (s3,b)=>(s3,b)/-1
[ a a B b a b [H] a b b b * ] --- (s3,a)=>(s3,a)/-1
[ a a B b a [H] b a b b b * ] --- (s3,b)=>(s3,b)/-1
[ a a B b [H] a b a b b b * ] --- (s3,a)=>(s3,a)/-1
[ a a B [H] b a b a b b b * ] --- (s3,b)=>(s3,b)/-1
[ a a [H] B b a b a b b b * ] --- (s3,B)=>(s0,a)/1
[ a a a [H] b a b a b b b * ] --- (s0,b)=>(s1,B)/1
[ a a a B [H] a b a b b b * ] --- (s1,a)=>(s1,a)/1
[ a a a B a [H] b a b b b * ] --- (s1,b)=>(s1,b)/1
[ a a a B a b [H] a b b b * ] --- (s1,a)=>(s1,a)/1
[ a a a B a b a [H] b b b * ] --- (s1,b)=>(s1,b)/1
[ a a a B a b a b [H] b b * ] --- (s1,b)=>(s1,b)/1
[ a a a B a b a b b [H] b * ] --- (s1,b)=>(s1,b)/1
[ a a a B a b a b b b [H] * ] --- (s1,*)=>(s2,*)/-1
[ a a a B a b a b b [H] b * ] --- (s2,b)=>(s2,b)/-1
[ a a a B a b a b [H] b b * ] --- (s2,b)=>(s2,b)/-1
[ a a a B a b a [H] b b b * ] --- (s2,b)=>(s2,b)/-1
[ a a a B a b [H] a b b b * ] --- (s2,a)=>(s3,b)/-1
[ a a a B a [H] b b b b b * ] --- (s3,b)=>(s3,b)/-1
[ a a a B [H] a b b b b b * ] --- (s3,a)=>(s3,a)/-1
[ a a a [H] B a b b b b b * ] --- (s3,B)=>(s0,a)/1
[ a a a a [H] a b b b b b * ] --- (s0,a)=>(s0,a)/1
[ a a a a a [H] b b b b b * ] --- (s0,b)=>(s1,B)/1
[ a a a a a B [H] b b b b * ] --- (s1,b)=>(s1,b)/1
[ a a a a a B b [H] b b b * ] --- (s1,b)=>(s1,b)/1
[ a a a a a B b b [H] b b * ] --- (s1,b)=>(s1,b)/1
[ a a a a a B b b b [H] b * ] --- (s1,b)=>(s1,b)/1
[ a a a a a B b b b b [H] * ] --- (s1,*)=>(s2,*)/-1
[ a a a a a B b b b [H] b * ] --- (s2,b)=>(s2,b)/-1
[ a a a a a B b b [H] b b * ] --- (s2,b)=>(s2,b)/-1
[ a a a a a B b [H] b b b * ] --- (s2,b)=>(s2,b)/-1
[ a a a a a B [H] b b b b * ] --- (s2,b)=>(s2,b)/-1
[ a a a a a [H] B b b b b * ] --- (s2,B)=>(se,b)/-1
[ a a a a [H] a b b b b b * ] --- (se,a)=>(se,a)/-1
[ a a a [H] a a b b b b b * ] --- (se,a)=>(se,a)/-1
[ a a [H] a a a b b b b b * ] --- (se,a)=>(se,a)/-1
[ a [H] a a a a b b b b b * ] --- (se,a)=>(se,a)/-1
[ [H] a a a a a b b b b b * ] --- (se,a)=>(se,a)/-1
[ [H] * a a a a a b b b b b * ] --- (se,*)=>(see,*)/1
[ * [H] a a a a a b b b b b * ] --- (see,a)
Output (sort): [*, a, a, a, a, a, b, b, b, b, b, *]

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].

Perl

<lang perl>use strict; use warnings;

sub run_utm { my %o = @_; my $st = $o{state} // die "init head state undefined"; my $blank = $o{blank} // die "blank symbol undefined"; my @rules = @{$o{rules}} or die "rules undefined"; my @tape = $o{tape} ? @{$o{tape}} : ($blank); my $halt = $o{halt};

my $pos = $o{pos} // 0; $pos += @tape if $pos < 0; die "bad init position" if $pos >= @tape || $pos < 0;

step: while (1) { print "$st\t"; for (0 .. $#tape) { my $v = $tape[$_]; print $_ == $pos ? "[$v]" : " $v "; } print "\n";

last if $st eq $halt; for (@rules) { my ($s0, $v0, $v1, $dir, $s1) = @$_; next unless $s0 eq $st and $tape[$pos] eq $v0;

$tape[$pos] = $v1;

if ($dir eq 'left') { if ($pos == 0) { unshift @tape, $blank} else { $pos-- } } elsif ($dir eq 'right') { push @tape, $blank if ++$pos >= @tape }

$st = $s1; next step; }

die "no matching rules"; } }

print "incr machine\n"; run_utm halt=>'qf', state=>'q0', tape=>[1,1,1], blank=>'B', rules=>[[qw/q0 1 1 right q0/], [qw/q0 B 1 stay qf/]];

print "\nbusy beaver\n"; run_utm halt=>'halt', state=>'a', blank=>'0', rules=>[[qw/a 0 1 right b/], [qw/a 1 1 left c/], [qw/b 0 1 left a/], [qw/b 1 1 right b/], [qw/c 0 1 left b/], [qw/c 1 1 stay halt/]];

print "\nsorting test\n"; run_utm halt=>'STOP', state=>'A', blank=>'0', tape=>[qw/2 2 2 1 2 2 1 2 1 2 1 2 1 2/], rules=>[[qw/A 1 1 right A/], [qw/A 2 3 right B/], [qw/A 0 0 left E/], [qw/B 1 1 right B/], [qw/B 2 2 right B/], [qw/B 0 0 left C/], [qw/C 1 2 left D/], [qw/C 2 2 left C/], [qw/C 3 2 left E/], [qw/D 1 1 left D/], [qw/D 2 2 left D/], [qw/D 3 1 right A/], [qw/E 1 1 left E/], [qw/E 0 0 right STOP/]];</lang>

Perl 6

Translation of: Perl
Works with: niecza version 2013-03-07

<lang perl6>sub run_utm(:$state! is copy, :$blank!, :@rules!, :@tape = [$blank], :$halt, :$pos is copy = 0) { 

   $pos += @tape if $pos < 0;
   die "Bad initial position" unless $pos ~~ ^@tape;

 step:
   print "$state\t";
   for ^@tape {

my $v = @tape[$_]; print $_ == $pos ?? "[$v]" !! " $v "; 

   }
   print "\n";

   return if $state eq $halt;
   for @rules -> @rule {

my ($s0, $v0, $v1, $dir, $s1) = @rule; next unless $s0 eq $state and @tape[$pos] eq $v0;

@tape[$pos] = $v1;

given $dir { when 'left' { if $pos == 0 { unshift @tape, $blank } else { $pos-- } } when 'right' { push @tape, $blank if ++$pos >= @tape; } }

$state = $s1; goto step; 

   }

   die "No matching rules";

}

say "incr machine"; run_utm :halt<qf>, :state<q0>, :tape[1,1,1], :blank, :rules[ [< q0 1 1 right q0 >], [< q0 B 1 stay qf >] ];

say "\nbusy beaver"; run_utm :halt<halt>, :state<a>, :blank<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 >] ];

say "\nsorting test"; run_utm :halt<STOP>, :state<A>, :blank<0>, :tape[< 2 2 2 1 2 2 1 2 1 2 1 2 1 2 >], :rules[ [< A 1 1 right A >], [< A 2 3 right B >], [< A 0 0 left E >], [< B 1 1 right B >], [< B 2 2 right B >], [< B 0 0 left C >], [< C 1 2 left D >], [< C 2 2 left C >], [< C 3 2 left E >], [< D 1 1 left D >], [< D 2 2 left D >], [< D 3 1 right A >], [< E 1 1 left E >], [< E 0 0 right STOP >] ];</lang>

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].

Racket

<lang racket>

  1. lang racket
=============================================================
Due to heavy use of pattern matching we define few macros
=============================================================

(define-syntax-rule (define-m f m ...) 

 (define f (match-lambda m ... (x x))))

(define-syntax-rule (define-m* f m ...) 

 (define f (match-lambda** m ...)))
=============================================================
The definition of a functional type Tape,
representing infinite tape with O(1) operations
put, get, shift-right and shift-left.
=============================================================

(struct Tape (the-left-part  ; i-1 i-2 i-3 ... 

             the-current-record ; i
             the-right-part))   ; i+1 i+2 i+3 ...
the initial record on the tape

(define-m initial-tape 

 [(cons h t) (Tape '() h t)])
shifts caret to the right

(define (snoc a b) (cons b a)) (define-m shift-right 

 [(Tape '() '() (cons h t)) (Tape '() h t)]      ; left end
 [(Tape  l x '()) (Tape (snoc l x) '() '())]     ; right end
 [(Tape  l x (cons h t)) (Tape (snoc l x) h t)]) ; general case
shifts caret to the left

(define-m flip-tape [(Tape l x r) (Tape r x l)])

(define shift-left 

 (compose flip-tape shift-right flip-tape))
returns the current record on the tape

(define-m get [(Tape _ v _) v])

writes to the current position on the tape

(define-m* put 

 [('() t) t]
 [(v (Tape l _ r)) (Tape l v r)])
Shows the list representation of the tape (≤ O(n)).
A tape is shown as (... a b c (d) e f g ...)
where (d) marks the current position of the caret.

(define (revappend a b) (foldl cons b a))

(define-m show-tape 

 [(Tape '() '() '()) '()]
 [(Tape l '() r) (revappend l (cons '() r))]
 [(Tape l v r) (revappend l (cons (list v) r))])
-------------------------------------------------------------------
The Turing Machine interpreter
interpretation of output triple for a given tape

(define-m* interprete 

 [((list v 'right S) tape) (list S (shift-right (put v tape)))]
 [((list v 'left S) tape) (list S (shift-left (put v tape)))]
 [((list v 'stay S) tape) (list S (put v tape))]
 [((list S _) tape) (list S tape)])
Runs the program.
The initial state is set to start.
The initial tape is given as a list of records.
The initial position is the leftmost symbol of initial record.

(define (run-turing prog t0 start) 

 ((fixed-point
   (match-lambda
     [`(,S ,T) (begin
                 (printf "~a\t~a\n" S (show-tape T))
                 (interprete (prog `(,S ,(get T))) T))]))
  (list start (initial-tape t0))))
a general fixed point operator

(define ((fixed-point f) x) 

 (let F ([x x] [fx (f x)])
   (if (equal? x fx)
       fx
       (F fx (f fx)))))
A macro for definition of a Turing-Machines.
Transforms to a function which accepts a list of initial
tape records as input and returns the tape after stopping.

(define-syntax-rule (Turing-Machine #:start start (a b c d e) ...) 

 (λ (l)
   (displayln "STATE\tTAPE")
   ((match-lambda [(list _ t) (flatten (show-tape t))]) 
    (run-turing 
     (match-lambda ['(a b) '(c d e)] ... [x x]) 
     l start))))

</lang>

The resulting Turing Machine is a function that maps the initial tape record to the final one, so that several machines could run one after another or composed as any other functions

Examples:

The simple incrementer: <lang racket> (define INC 

 (Turing-Machine #:start 'q0
   [q0 1 1 right q0]
   [q0 () 1 stay qf]))

</lang> 

> (INC '(1 1 1))
STATE	TAPE
q0	((1) 1 1)
q0	(1 (1) 1)
q0	(1 1 (1))
q0	(1 1 1 ())
qf	(1 1 1 (1))
(1 1 1 1)


The incrementer for binary numbers <lang racket> (define ADD1 

 (Turing-Machine #:start 'Start
  [Start 1  1  right Start]
  [Start 0  0  right Start]
  [Start () () left  Add]
  [Add   0  1  stay  End]
  [Add   1  0  left  Add]
  [Add   () 1  stay  End]))

</lang> 

> (ADD1 '(1 1 0))
STATE	TAPE
Start	((1) 1 0)
Start	(1 (1) 0)
Start	(1 1 (0))
Start	(1 1 0 ())
Add	(1 1 (0))
End	(1 1 (1))
(1 1 1)
> (define ADD2 (compose ADD1 ADD1))
> (ADD2 '(1 1 0))
STATE	TAPE
Start	((1) 1 0)
Start	(1 (1) 0)
Start	(1 1 (0))
Start	(1 1 0 ())
Add	(1 1 (0))
End	(1 1 (1))
STATE	TAPE
Start	((1) 1 1)
Start	(1 (1) 1)
Start	(1 1 (1))
Start	(1 1 1 ())
Add	(1 1 (1))
Add	(1 (1) 0)
Add	((1) 0 0)
Add	(() 0 0 0)
End	((1) 0 0 0)
(1 0 0 0)

The busy beaver <lang racket> (define BEAVER 

 (Turing-Machine #:start 'a
  [a () 1 right b]
  [a  1 1 left  c]
  [b () 1 left  a]
  [b  1 1 right b]
  [c () 1 left  b]
  [c  1 1 stay  halt]))

</lang> 

> (BEAVER '(()))
STATE	TAPE
a	()
b	(1 ())
a	((1) 1)
c	(() 1 1)
b	(() 1 1 1)
a	(() 1 1 1 1)
b	(1 (1) 1 1 1)
b	(1 1 (1) 1 1)
b	(1 1 1 (1) 1)
b	(1 1 1 1 (1))
b	(1 1 1 1 1 ())
a	(1 1 1 1 (1) 1)
c	(1 1 1 (1) 1 1)
halt	(1 1 1 (1) 1 1)
(1 1 1 1 1 1)

The sorting machine <lang racket> (define SORT 

 (Turing-Machine #:start 'A
  [A 1  1  right A]
  [A 2  3  right B]
  [A () () left  E]
  [B 1  1  right B]
  [B 2  2  right B]
  [B () () left  C]
  [C 1  2  left  D]
  [C 2  2  left  C]
  [C 3  2  left  E]
  [D 1  1  left  D]
  [D 2  2  left  D]
  [D 3  1  right A]
  [E 1  1  left  E]
  [E () () right STOP]))

</lang> 

> (SORT '(2 1 2 2 2 1 1))
STATE	TAPE
A	((2) 1 2 2 2 1 1)
B	(3 (1) 2 2 2 1 1)
B	(3 1 (2) 2 2 1 1)
B	(3 1 2 (2) 2 1 1)
B	(3 1 2 2 (2) 1 1)
B	(3 1 2 2 2 (1) 1)
B	(3 1 2 2 2 1 (1))
B	(3 1 2 2 2 1 1 ())
C	(3 1 2 2 2 1 (1))
D	(3 1 2 2 2 (1) 2)
D	(3 1 2 2 (2) 1 2)
D	(3 1 2 (2) 2 1 2)
D	(3 1 (2) 2 2 1 2)
D	(3 (1) 2 2 2 1 2)
D	((3) 1 2 2 2 1 2)
A	(1 (1) 2 2 2 1 2)
A	(1 1 (2) 2 2 1 2)
B	(1 1 3 (2) 2 1 2)
B	(1 1 3 2 (2) 1 2)
B	(1 1 3 2 2 (1) 2)
B	(1 1 3 2 2 1 (2))
B	(1 1 3 2 2 1 2 ())
C	(1 1 3 2 2 1 (2))
C	(1 1 3 2 2 (1) 2)
D	(1 1 3 2 (2) 2 2)
D	(1 1 3 (2) 2 2 2)
D	(1 1 (3) 2 2 2 2)
A	(1 1 1 (2) 2 2 2)
B	(1 1 1 3 (2) 2 2)
B	(1 1 1 3 2 (2) 2)
B	(1 1 1 3 2 2 (2))
B	(1 1 1 3 2 2 2 ())
C	(1 1 1 3 2 2 (2))
C	(1 1 1 3 2 (2) 2)
C	(1 1 1 3 (2) 2 2)
C	(1 1 1 (3) 2 2 2)
E	(1 1 (1) 2 2 2 2)
E	(1 (1) 1 2 2 2 2)
E	((1) 1 1 2 2 2 2)
E	(() 1 1 1 2 2 2 2)
STOP	((1) 1 1 2 2 2 2)
(1 1 1 2 2 2 2)

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>

Tcl

<lang tcl>proc turing {states initial terminating symbols blank tape rules {doTrace 1}} { 

   set state $initial
   set idx 0
   set tape [split $tape ""]
   if {[llength $tape] == 0} {

set tape [list $blank] 

   }
   foreach rule $rules {

lassign $rule state0 sym0 sym1 move state1 set R($state0,$sym0) [list $sym1 $move $state1] 

   }
   while {$state ni $terminating} {

set sym [lindex $tape $idx] lassign $R($state,$sym) sym1 move state1 if {$doTrace} { ### Print the state, great for debugging puts "[join $tape ""]\t$state->$state1" puts "[string repeat { } $idx]^" } lset tape $idx $sym1 switch $move { left { if {[incr idx -1] < 0} { set idx 0 set tape [concat [list $blank] $tape] } } right { if {[incr idx] == [llength $tape]} { lappend tape $blank } } } set state $state1 

   }
   return [join $tape ""]

}</lang> Demonstrating: <lang tcl>puts "Simple incrementer" puts TAPE=[turing {q0 qf} q0 qf {1 B} B "111" { 

   {q0 1 1 right q0}
   {q0 B 1 stay qf}

}] puts "Three-state busy beaver" puts TAPE=[turing {a b c halt} a halt {0 1} 0 "" { 

   {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}

}] puts "Sorting stress test"

  1. We suppress the trace output for this so as to keep the output short

puts TAPE=[turing {A B C D E H} A H {0 1 2 3} 0 "12212212121212" { 

   {A 1 1 right A}
   {A 2 3 right B}
   {A 0 0 left E}
   {B 1 1 right B}
   {B 2 2 right B}
   {B 0 0 left C}
   {C 1 2 left D}
   {C 2 2 left C}
   {C 3 2 left E}
   {D 1 1 left D}
   {D 2 2 left D}
   {D 3 1 right A}
   {E 1 1 left E}
   {E 0 0 right H}

} no]</lang>

Output:
Simple incrementer
111	q0->q0
^
111	q0->q0
 ^
111	q0->q0
  ^
111B	q0->qf
   ^
TAPE=1111
Three-state busy beaver
0	a->b
^
10	b->a
 ^
11	a->c
^
011	c->b
^
0111	b->a
^
01111	a->b
^
11111	b->b
 ^
11111	b->b
  ^
11111	b->b
   ^
11111	b->b
    ^
111110	b->a
     ^
111111	a->c
    ^
111111	c->halt
   ^
TAPE=111111
Sorting stress test
TAPE=0111111222222220
Retrieved from "https://rosettacode.org/wiki/Universal_Turing_machine?oldid=224244"