using System;
using System.Collections.Generic;
using System.Diagnostics;
using System.Linq;
using System.Text;
using System.Threading;
using System.Threading.Tasks;

public class TuringMachine
{
    public static async Task Main() {
        var fiveStateBusyBeaver = new TuringMachine("A", '0', "H").WithTransitions(
            ("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")
        );
        var busyBeaverTask = fiveStateBusyBeaver.TimeAsync();

        var incrementer = new TuringMachine("q0", 'B', "qf").WithTransitions(
            ("q0", '1', '1', Right, "q0"),
            ("q0", 'B', '1', Stay,  "qf")
        )
        .WithInput("111");
        foreach (var _ in incrementer.Run()) PrintLine(incrementer);
        PrintResults(incrementer);

        var threeStateBusyBeaver = new TuringMachine("a", '0', "halt").WithTransitions(
            ("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")
        );
        foreach (var _ in threeStateBusyBeaver.Run()) PrintLine(threeStateBusyBeaver);
        PrintResults(threeStateBusyBeaver);

        var sorter = new TuringMachine("A", '*', "X").WithTransitions(
            ("A", 'a', 'a', Right, "A"),
            ("A", 'b', 'B', Right, "B"),
            ("A", '*', '*', Left,  "E"),
            ("B", 'a', 'a', Right, "B"),
            ("B", 'b', 'b', Right, "B"),
            ("B", '*', '*', Left,  "C"),
            ("C", 'a', 'b', Left,  "D"),
            ("C", 'b', 'b', Left,  "C"),
            ("C", 'B', 'b', Left,  "E"),
            ("D", 'a', 'a', Left,  "D"),
            ("D", 'b', 'b', Left,  "D"),
            ("D", 'B', 'a', Right, "A"),
            ("E", 'a', 'a', Left,  "E"),
            ("E", '*', '*', Right, "X")
        )
        .WithInput("babbababaa");
        sorter.Run().Last();
        Console.WriteLine("Sorted: " + sorter.TapeString);
        PrintResults(sorter);

        sorter.Reset().WithInput("bbbababaaabba");
        sorter.Run().Last();
        Console.WriteLine("Sorted: " + sorter.TapeString);
        PrintResults(sorter);

        Console.WriteLine(await busyBeaverTask);
        PrintResults(fiveStateBusyBeaver);

        void PrintLine(TuringMachine tm) => Console.WriteLine(tm.TapeString + "\tState " + tm.State);

        void PrintResults(TuringMachine tm) {
            Console.WriteLine($"End state: {tm.State} = {(tm.Success ? "Success" : "Failure")}");
            Console.WriteLine(tm.Steps + " steps");
            Console.WriteLine("tape length: " + tm.TapeLength);
            Console.WriteLine();
        }
    }

    public const int Left = -1, Stay = 0, Right = 1;
    private readonly Tape tape;
    private readonly string initialState;
    private readonly HashSet<string> terminatingStates;
    private Dictionary<(string state, char read), (char write, int move, string toState)> transitions;

    public TuringMachine(string initialState, char blankSymbol, params string[] terminatingStates) {
        State = this.initialState = initialState;
        tape = new Tape(blankSymbol);
        this.terminatingStates = terminatingStates.ToHashSet();
    }

    public TuringMachine WithTransitions(
        params (string state, char read, char write, int move, string toState)[] transitions)
    {
        this.transitions = transitions.ToDictionary(k => (k.state, k.read), k => (k.write, k.move, k.toState));
        return this;
    }

    public TuringMachine Reset() {
        State = initialState;
        Steps = 0;
        tape.Reset();
        return this;
    }

    public TuringMachine WithInput(string input) {
        tape.Input(input);
        return this;
    }

    public int Steps { get; private set; }
    public string State { get; private set; }
    public bool Success => terminatingStates.Contains(State);
    public int TapeLength => tape.Length;
    public string TapeString => tape.ToString();

    public IEnumerable<string> Run() {
        yield return State;
        while (Step()) yield return State;
    }

    public async Task<TimeSpan> TimeAsync(CancellationToken cancel = default) {
        var chrono = Stopwatch.StartNew();
        await RunAsync(cancel);
        chrono.Stop();
        return chrono.Elapsed;
    }

    public Task RunAsync(CancellationToken cancel = default)
        => Task.Run(() => {
            while (Step()) cancel.ThrowIfCancellationRequested();
        });

    private bool Step() {
        if (!transitions.TryGetValue((State, tape.Current), out var action)) return false;
        tape.Current = action.write;
        tape.Move(action.move);
        State = action.toState;
        Steps++;
        return true;
    }

    private class Tape
    {
        private List<char> forwardTape = new List<char>(), backwardTape = new List<char>();
        private int head = 0;
        private char blank;

        public Tape(char blankSymbol) => forwardTape.Add(blank = blankSymbol);

        public void Reset() {
            backwardTape.Clear();
            forwardTape.Clear();
            head = 0;
            forwardTape.Add(blank);
        }

        public void Input(string input) {
            Reset();
            forwardTape.Clear();
            forwardTape.AddRange(input);
        }

        public void Move(int direction) {
            head += direction;
            if (head >= 0 && forwardTape.Count <= head) forwardTape.Add(blank);
            if (head < 0 && backwardTape.Count <= ~head) backwardTape.Add(blank);
        }

        public char Current {
            get => head < 0 ? backwardTape[~head] : forwardTape[head];
            set {
                if (head < 0) backwardTape[~head] = value;
                else forwardTape[head] = value;
            }
        }

        public int Length => backwardTape.Count + forwardTape.Count;

        public override string ToString() {
            int h = (head < 0 ? ~head : backwardTape.Count + head) * 2 + 1;
            var builder = new StringBuilder(" ", Length * 2 + 1);
            if (backwardTape.Count > 0) {
                builder.Append(string.Join(" ", backwardTape)).Append(" ");
                if (head < 0) (builder[h + 1], builder[h - 1]) = ('(', ')');
                for (int l = 0, r = builder.Length - 1; l < r; l++, r--) (builder[l], builder[r]) = (builder[r], builder[l]);
            }
            builder.Append(string.Join(" ", forwardTape)).Append(" ");
            if (head >= 0) (builder[h - 1], builder[h + 1]) = ('(', ')');
            return builder.ToString();
        }

    }

}


#include <vector>
#include <string>
#include <iostream>
#include <algorithm>
#include <fstream>
#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; }
//--------------------------------------------------------------------------------------------------


(defn tape
  "Creates a new tape with given blank character and tape contents"
  ([blank] (tape () blank () blank))
  ([right blank] (tape () (first right) (rest right) blank))
  ([left head right blank] [(reverse left) (or head blank) (into () right) blank]))

; Tape operations
(defn- left  [[[l & ls] _ rs       b] c] [ls          (or l b) (conj rs c) b])
(defn- right [[ls       _ [r & rs] b] c] [(conj ls c) (or r b) rs          b])
(defn- stay  [[ls       _ rs       b] c] [ls          c        rs          b])
(defn- head [[_ c _ b]] (or c b))
(defn- pretty [[ls c rs b]] (concat (reverse ls) [[(or c b)]] rs))

(defn new-machine
 "Returns a function that takes a tape as input, and returns the tape
  after running the machine specified in `machine`."
  [machine]
  (let [rules (into {} (for [[s c c' a s'] (:rules machine)]
                         [[s c] [c' (-> a name symbol resolve) s']]))
        finished? (into #{} (:terminating machine))]
    (fn [input-tape]
      (loop [state (:initial machine) tape input-tape]
        (if (finished? state)
          (pretty tape)
          (let [[out action new-state] (get rules [state (head tape)])]
            (recur new-state (action tape out))))))))


% 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


(defun turing (initial terminal blank rules tape &optional (verbose NIL))
  (labels ((combine (front back)
             (if front
               (combine (cdr front) (cons (car front) back))
               back))

           (update-tape (old-front old-back new-content move)
             (cond ((eq move 'right)
                    (list (cons new-content old-front)
                          (cdr old-back)))
                   ((eq move 'left)
                    (list (cdr old-front)
                          (list* (car old-front) new-content (cdr old-back))))
                   (T (list old-front
                            (cons new-content (cdr old-back))))))

           (show-tape (front back)
             (format T "~{~a~}[~a]~{~a~}~%"
                     (nreverse (subseq front 0 (min 10 (length front))))
                     (or (car back) blank)
                     (subseq (cdr back) 0 (min 10 (length (cdr back)))))))

    (loop for back = tape then new-back
          for front = '() then new-front
          for state = initial then new-state
          for content = (or (car back) blank)
          for (new-state new-content move) = (gethash (cons state content) rules)
          for (new-front new-back) = (update-tape front back new-content move)
          until (equal state terminal)
          do (when verbose
               (show-tape front back))
          finally (progn
                    (when verbose
                      (show-tape front back))
                    (return (combine front back))))))


include "cowgol.coh";
include "strings.coh";
include "malloc.coh";

###############################################################################
########################## Turing machine definition ##########################
###############################################################################
typedef Symbol is uint8; # 256 symbols ought to be enough for everyone

const LEFT := 1;
const RIGHT := 2;
const STAY := 3;
typedef Action is int(LEFT, STAY);

# Linked list
record Linked is
    next: [Linked];
end record;

record DoublyLinked: Linked is
    prev: [DoublyLinked];
end record;

sub FreeLinked(r: [Linked]) is
    while r != 0 as [Linked] loop
        var v := r.next;
        Free(r as [uint8]);
        r := v;
    end loop;
end sub;

sub FreeDoublyLinked(r: [DoublyLinked]) is
    FreeLinked(r.next);
    while r != 0 as [DoublyLinked] loop
        var v := r.prev;
        Free(r as [uint8]);
        r := v;
    end loop;
end sub;

# Turing machine
typedef Turing is [TuringR];
record StateR: Linked is
    tm: Turing;     # turing machine this state belongs to
    term: uint8;    # whether state is terminating
end record;
typedef State is [StateR];

record Cell: DoublyLinked is
    sym: Symbol;
end record;

record RuleR: Linked is
    instate: State;
    insym: Symbol;
    outsym: Symbol;
    action: Action;
    outstate: State;
end record;
typedef Rule is [RuleR];

record TuringR is
    states: State;
    rules: Rule;
    initial: State;
    current: State;
    blank: Symbol;
    head: [Cell];
end record;

sub MakeCell(): (c: [Cell]) is
    c := Alloc(@bytesof Cell) as [Cell];
    MemZero(c as [uint8], @bytesof Cell);
end sub;

# Define a Turing machine
sub MakeTuring(blank: Symbol, init: [Symbol]): (t: Turing) is
    t := Alloc(@bytesof TuringR) as Turing;
    MemZero(t as [uint8], @bytesof TuringR);
    t.blank := blank;
    t.head := MakeCell();
    t.head.sym := blank;

    var c := t.head;
    var d: [Cell];
    while [init] != 0 loop
        c.sym := [init];
        init := @next init;
        if [init] == 0 then break; end if;
        d := Alloc(@bytesof Cell) as [Cell];
        d.prev := c as [DoublyLinked];
        d.next := 0 as [Linked];
        c.next := d as [Linked];
        c := d;
    end loop;
end sub;

# Add a state to a Turing machine
const T_NONE := 0;
const T_INIT := 1;
const T_HALT := 2;
sub MakeState(t: Turing, type: uint8): (s: State) is
    s := Alloc(@bytesof StateR) as State;
    s.tm := t;
    s.next := t.states as [Linked];
    t.states := s;

    if type & T_INIT != 0 then
        t.initial := s;
        t.current := s;
    end if;
    s.term := 0;
    if type & T_HALT != 0 then
        s.term := 1;
    end if;
end sub;

# Add a rule to a Turing machine
sub MakeRule(t: Turing,
             instate: State,
             insym: Symbol,
             outsym: Symbol,
             action: Action,
             outstate: State): (r: Rule) is
    r := Alloc(@bytesof RuleR) as Rule;
    r.instate := instate;
    r.insym := insym;
    r.outsym := outsym;
    r.action := action;
    r.outstate := outstate;
    r.next := t.rules as [Linked];
    t.rules := r;
end sub;

# Free a Turing machine
sub FreeTuring(t: Turing) is
    FreeDoublyLinked(t.head as [DoublyLinked]);
    FreeLinked(t.states as [Linked]);
    FreeLinked(t.rules as [Linked]);
    Free(t as [uint8]);
end sub;

# Move the head
sub MoveHead(t: Turing, a: Action) is
    var c: [Cell];
    case a is
        when STAY: return;
        when LEFT:
            if t.head.prev == 0 as [DoublyLinked] then
                c := Alloc(@bytesof Cell) as [Cell];
                c.prev := 0 as [DoublyLinked];
                c.next := t.head as [Linked];
                c.sym := t.blank;
                t.head.prev := c as [DoublyLinked];
            end if;
            t.head := t.head.prev as [Cell];
            return;
        when RIGHT:
            if t.head.next == 0 as [Linked] then
                c := Alloc(@bytesof Cell) as [Cell];
                c.next := 0 as [Linked];
                c.prev := t.head as [DoublyLinked];
                c.sym := t.blank;
                t.head.next := c as [Linked];
            end if;
            t.head := t.head.next as [Cell];
            return;
        when else:
            print("Invalid action\n");
            ExitWithError();
    end case;
end sub;

# Step a Turing machine
sub Step(t: Turing): (halt: uint8) is
    # If we're in a halt state, do nothing
    if t.current.term != 0 then
        halt := 1;
        return;
    end if;

    var r := t.rules;
    while r != 0 as Rule loop
        # Check each rule to see if it matches the current configuration
        if  t.current  == r.instate
        and t.head.sym == r.insym then
            # Found a match
            t.head.sym := r.outsym;
            MoveHead(t, r.action);
            t.current := r.outstate;
            halt := t.current.term;
            return;
        end if;
        r := r.next as Rule;
    end loop;
    print("No valid rule!\n");
    ExitWithError();
end sub;

# Run a Turing machine until it halts
sub Run(t: Turing) is
    while Step(t) == 0 loop
    end loop;
end sub;

# Print the touched part of the tape of a Turing machine
sub PrintTape(t: Turing, max: uint32) is
    var c := t.head;
    var len: uint32 := 0;
    while c.prev != 0 as [DoublyLinked] loop
        c := c.prev as [Cell];
    end loop;
    while c != 0 as [Cell] loop
        if len < max then
            print_char(c.sym as uint8);
        end if;
        c := c.next as [Cell];
        len := len + 1;
    end loop;
    if len >= max then
        print("... (total length: ");
        print_i32(len);
        print(")");
    end if;
end sub;

###############################################################################
######################## Turing machines from the task ########################
###############################################################################

interface TuringFactory(): (t: Turing);

sub SimpleIncrementer implements TuringFactory is
    var r: Rule;
    t := MakeTuring('B', "111");
    var q0 := MakeState(t, T_INIT);
    var qf := MakeState(t, T_HALT);
    r := MakeRule(t, q0, '1', '1', RIGHT, q0);
    r := MakeRule(t, q0, 'B', '1', STAY, qf);
end sub;

sub ThreeStateBeaver implements TuringFactory is
    var r: Rule;
    t := MakeTuring('0', "");
    var a := MakeState(t, T_INIT);
    var b := MakeState(t, T_NONE);
    var c := MakeState(t, T_NONE);
    var halt := MakeState(t, T_HALT);
    r := MakeRule(t, a, '0', '1', RIGHT, b);
    r := MakeRule(t, a, '1', '1', LEFT, c);
    r := MakeRule(t, b, '0', '1', LEFT, a);
    r := MakeRule(t, b, '1', '1', RIGHT, b);
    r := MakeRule(t, c, '0', '1', LEFT, b);
    r := MakeRule(t, c, '1', '1', STAY, halt);
end sub;

sub FiveStateBeaver implements TuringFactory is
    var r: Rule;
    t := MakeTuring('0', "");
    var A := MakeState(t, T_INIT);
    var B := MakeState(t, T_NONE);
    var C := MakeState(t, T_NONE);
    var D := MakeState(t, T_NONE);
    var E := MakeState(t, T_NONE);
    var H := MakeState(t, T_HALT);
    r := MakeRule(t, A, '0', '1', RIGHT, B);
    r := MakeRule(t, A, '1', '1', LEFT,  C);
    r := MakeRule(t, B, '0', '1', RIGHT, C);
    r := MakeRule(t, B, '1', '1', RIGHT, B);
    r := MakeRule(t, C, '0', '1', RIGHT, D);
    r := MakeRule(t, C, '1', '0', LEFT,  E);
    r := MakeRule(t, D, '0', '1', LEFT,  A);
    r := MakeRule(t, D, '1', '1', LEFT,  D);
    r := MakeRule(t, E, '0', '1', STAY,  H);
    r := MakeRule(t, E, '1', '0', LEFT,  A);
end sub;

record TF is
    name: [uint8];
    tf: TuringFactory;
end record;

var machines: TF[] := {
    {"Simple incrementer", SimpleIncrementer},
    {"Three state beaver", ThreeStateBeaver},
    {"Five state beaver", FiveStateBeaver}
};

var i: @indexof machines;
i := 0;
while i < @sizeof machines loop
    print(machines[i].name);
    print(": ");
    var t := (machines[i].tf) ();
    Run(t);
    PrintTape(t, 32);
    FreeTuring(t);
    print_nl();
    i := i + 1;
end loop;


import std.stdio, std.algorithm, std.string, std.conv, std.array,
       std.exception, std.traits, std.math, std.range;

struct UTM(State, Symbol, bool doShow=true)
if (is(State == enum) && is(Symbol == enum)) {
    static assert(is(typeof({ size_t x = State.init; })),
                  "State must to be usable as array index.");
    static assert([EnumMembers!State].equal(EnumMembers!State.length.iota),
                  "State must be a plain enum.");
    static assert(is(typeof({ size_t x = Symbol.init; })),
                  "Symbol must to be usable as array index.");
    static assert([EnumMembers!Symbol].equal(EnumMembers!Symbol.length.iota),
                  "Symbol must be a plain enum.");

    enum Direction { right, left, stay }

    private const TuringMachine tm;
    private TapeHead head;
    alias SymbolMap = string[EnumMembers!Symbol.length];

    // The first index of this 'rules' matrix is a subtype of State
    // because it can't contain H, but currently D can't enforce this,
    // statically unlike Ada language.
    Rule[EnumMembers!Symbol.length][EnumMembers!State.length - 1] mRules;

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

        this(in Symbol toWrite_, in Direction direction_, in State nextState_)
        pure nothrow @safe @nogc {
            this.toWrite = toWrite_;
            this.direction = direction_;
            this.nextState = nextState_;
        }
    }

    // This is kept separated from the rest so it can be inialized
    // one field at a time in the main function, yet it will become
    // const.
    static struct TuringMachine {
        Symbol blank;
        State initialState;
        Rule[Symbol][State] rules;
        Symbol[] input;
        SymbolMap symbolMap;
    }

    static struct TapeHead {
        immutable Symbol blank;
        Symbol[] tapeLeft, tapeRight;
        int position;
        const SymbolMap sMap;
        size_t nSteps;

        this(in ref TuringMachine t) pure nothrow @safe {
            this.blank = EnumMembers!Symbol[0];
            //tapeRight = t.input.empty ? [this.blank] : t.input.dup;
            if (t.input.empty)
                this.tapeRight = [this.blank];
            else
                this.tapeRight = t.input.dup;
            this.position = 0;
            this.sMap = t.symbolMap;
        }

        pure nothrow @safe @nogc invariant {
            assert(this.tapeRight.length > 0);
            if (this.position >= 0)
                assert(this.position < this.tapeRight.length);
            else
                assert(this.position.abs <= this.tapeLeft.length);
        }

        Symbol readSymb() const pure nothrow @safe @nogc {
            if (this.position >= 0)
                return this.tapeRight[this.position];
            else
                return this.tapeLeft[this.position.abs - 1];
        }

        void showSymb() const @safe {
            this.write;
        }

        void writeSymb(in Symbol symbol) @safe {
            static if (doShow)
                showSymb;
            if (this.position >= 0)
                this.tapeRight[this.position] = symbol;
            else
                this.tapeLeft[this.position.abs - 1] = symbol;
        }

        void goRight() pure nothrow @safe {
            this.position++;
            if (position > 0 && position == tapeRight.length)
                tapeRight ~= blank;
        }

        void goLeft() pure nothrow @safe {
            this.position--;
            if (position < 0 && (position.abs - 1) == tapeLeft.length)
                tapeLeft ~= blank;
        }

        void move(in Direction dir) pure nothrow @safe {
            nSteps++;
            final switch (dir) with (Direction) {
                case left:  goLeft;        break;
                case right: goRight;       break;
                case stay:  /*Do nothing*/ break;
            }
        }

        string toString() const @safe {
            immutable pos = tapeLeft.length.signed + this.position + 4;
            return format("...%-(%)...", tapeLeft.retro.chain(tapeRight)
                                         .map!(s => sMap[s])) ~
                   '\n' ~
                   format("%" ~ pos.text ~ "s", "^") ~
                   '\n';
        }
    }

    void show() const @safe {
        head.showSymb;
    }

    this(in ref TuringMachine tm_) @safe {
        static assert(__traits(compiles, State.H), "State needs a 'H' (Halt).");
        immutable errMsg = "Invalid input.";
        auto runningStates = remove!(s => s == State.H)([EnumMembers!State]);
        enforce(!runningStates.empty, errMsg);
        enforce(tm_.rules.length == EnumMembers!State.length - 1, errMsg);
        enforce(State.H !in tm_.rules, errMsg);
        enforce(runningStates.canFind(tm_.initialState), errMsg);

        // Create a matrix to reduce running time.
        foreach (immutable State st, const rset; tm_.rules)
            foreach (immutable Symbol sy, immutable rule; rset)
                mRules[st][sy] = rule;

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

        State state = tm.initialState;
        while (state != State.H) {
            immutable next = mRules[state][head.readSymb];
            head.writeSymb(next.toWrite);
            head.move(next.direction);
            state = next.nextState;
        }
        static if (doShow)
            show;
        writeln("Performed ", head.nSteps, " steps.");
    }
}

void main() @safe {
    "Incrementer:".writeln;
    enum States1 : ubyte { A, H }
    enum Symbols1 : ubyte { s0, s1 }
    alias M1 = UTM!(States1, Symbols1);
    M1.TuringMachine tm1;
    with (tm1) with (States1) with (Symbols1) with (M1.Direction) {
        alias R = M1.Rule;
        initialState = A;
        rules = [A: [s0: R(s1, stay,  H), s1: R(s1, right, A)]];
        input = [s1, s1, s1];
        symbolMap = ["0", "1"];
    }
    M1(tm1);

    // http://en.wikipedia.org/wiki/Busy_beaver
    "\nBusy Beaver machine (3-state, 2-symbol):".writeln;
    enum States2 : ubyte { A, B, C, H }
    alias Symbols2 = Symbols1;
    alias M2 = UTM!(States2, Symbols2);
    M2.TuringMachine tm2;
    with (tm2) with (States2) with (Symbols2) with (M2.Direction) {
        alias R = M2.Rule;
        initialState = A;
        rules = [A: [s0: R(s1, right, B), s1: R(s1, left,  C)],
                 B: [s0: R(s1, left,  A), s1: R(s1, right, B)],
                 C: [s0: R(s1, left,  B), s1: R(s1, stay,  H)]];
        symbolMap = ["0", "1"];
    }
    M2(tm2);

    "\nSorting stress test (12212212121212):".writeln;
    enum States3 : ubyte { A, B, C, D, E, H }
    enum Symbols3 : ubyte { s0, s1, s2, s3 }
    alias M3 = UTM!(States3, Symbols3, false);
    M3.TuringMachine tm3;
    with (tm3) with (States3) with (Symbols3) with (M3.Direction) {
        alias R = M3.Rule;
        initialState = A;
        rules = [A: [s1: R(s1, right, A),
                     s2: R(s3, right, B),
                     s0: R(s0, left,  E)],
                 B: [s1: R(s1, right, B),
                     s2: R(s2, right, B),
                     s0: R(s0, left,  C)],
                 C: [s1: R(s2, left,  D),
                     s2: R(s2, left,  C),
                     s3: R(s2, left,  E)],
                 D: [s1: R(s1, left,  D),
                     s2: R(s2, left,  D),
                     s3: R(s1, right, A)],
                 E: [s1: R(s1, left,  E),
                     s0: R(s0, stay,  H)]];
        input = [s1, s2, s2, s1, s2, s2, s1,
                 s2, s1, s2, s1, s2, s1, s2];
        symbolMap = ["0", "1", "2", "3"];
    }
    M3(tm3).show;

    "\nPossible best Busy Beaver machine (5-state, 2-symbol):".writeln;
    alias States4 = States3;
    alias Symbols4 = Symbols1;
    alias M4 = UTM!(States4, Symbols4, false);
    M4.TuringMachine tm4;
    with (tm4) with (States4) with (Symbols4) with (M4.Direction) {
        alias R = M4.Rule;
        initialState = A;
        rules = [A: [s0: R(s1, right, B), s1: R(s1, left,  C)],
                 B: [s0: R(s1, right, C), s1: R(s1, right, B)],
                 C: [s0: R(s1, right, D), s1: R(s0, left,  E)],
                 D: [s0: R(s1, left,  A), s1: R(s1, left,  D)],
                 E: [s0: R(s1, stay,  H), s1: R(s0, left,  A)]];
        symbolMap = ["0", "1"];
    }
    M4(tm4);
}


transitions(:
	local :t {}
	while /= ) dup:
		set-to t swap & rot & rot rot &
	t drop

take-from tape:
	if tape:
		pop-from tape
	else:
		:B

paste-together a h b:
	push-to b h
	while a:
		push-to b pop-from a
	b

universal-turing-machine transitions initial final tape:
	local :tape-left []
	local :state initial

	local :head take-from tape

	local :move { :stay @pass }

	move!left:
		push-to tape head
		set :head take-from tape-left

	move!right:
		push-to tape-left head
		set :head take-from tape

	while /= state final:
		if opt-get transitions & state head:
			set :state &<>
			set :head &<>
			move!
		else:
			return paste-together tape-left head tape
	paste-together tape-left head tape


(require 'struct)

(struct TM (read-only: name states symbs final rules mem  state-values: tape pos state))

(define-syntax-rule (rule-idx state symb numstates)
    (+ state (* symb numstates)))

(define-syntax-rule (make-TM name states symbs rules)
    (_make-TM  name 'states 'symbs 'rules))

;; a rule is (state symbol --> write move new-state)
;; index for rule = state-num + (number of states)  * symbol-num
;; convert states/symbol into vector indices
(define (compile-rule T rule  into: rules)
    (define numstates (vector-length (TM-states T)))
    (define state (vector-index [rule 0](TM-states T) )) ; index
    (define symb (vector-index [rule 1](TM-symbs T) ))
    (define write-symb (vector-index [rule 2] (TM-symbs T)  ))
    (define move (1- (vector-index  [rule 3] #(left stay right) )))
    (define new-state (vector-index  [rule 4](TM-states T)))
    (define rulenum (rule-idx state symb numstates))
    (vector-set! rules rulenum (vector write-symb move new-state))
    ; (writeln 'rule  rulenum [rules rulenum])
    )

(define (_make-TM name states symbs rules)
    (define T (TM  name (list->vector states) (list->vector symbs) null null))
    (set-TM-final! T (1-  (length states))) ;; assume one final state
    (set-TM-rules! T (make-vector (* (length states) (length symbs))))
    (for ((rule rules)) (compile-rule T (list->vector rule) into: (TM-rules T)))
    T ) ; returns a TM

;;------------------
;; TM-trace
;;-------------------
(string-delimiter "")

(define (TM-print T symb-index: symb (hilite #f))
	(cond
	((= 0 symb) (if hilite "🔲"  "◽" ))
	((= 1 symb) (if hilite  "🔳 " "◾" ))
	(else "X")))

(define (TM-trace T tape pos state step)
	(if (= (TM-final T) state)
		(write "🔴")
		(write "🔵"))

    (for [(p (in-range  (- (TM-mem T) 7) (+ (TM-mem T) 8)))]
        (write (TM-print T [tape p] (= p pos))))
    (write step)
    (writeln))

;;---------------
;; TM-init : alloc and init tape
;;---------------
(define (TM-init T input-symbs (mem 20))
    ;; init state variables
    (set-TM-tape! T (make-vector (* 2 mem)))
    (set-TM-pos!  T  mem)
    (set-TM-state! T 0)
    (set-TM-mem! T mem)

    (for [(symb input-symbs) (i (in-naturals))]
        (vector-set! (TM-tape T) [+ i (TM-pos T)] (vector-index symb (TM-symbs T))))
    (TM-trace T  (TM-tape T) mem 0 0)
    mem )

;;---------------
;; TM-run : run at most maxsteps
;;---------------
(define (TM-run T  (verbose #f)  (maxsteps 1_000_000))
(define count 0)
    (define final (TM-final T))
    (define rules (TM-rules T))
    (define rule 0)
    (define numstates (vector-length (TM-states T)))
    ;; set current state vars
    (define pos (TM-pos T))
    (define state (TM-state T))
    (define tape (TM-tape T))

    (when (and (zero? state) (= pos (TM-mem T)))
    	 (writeln 'Starting (TM-name T))
    	 (TM-trace T tape pos 0 count))

    (while (and (!= state final) (< count maxsteps))
    (++ count)
;; The machine
        (set! rule [rules (rule-idx state [tape pos] numstates)])
        (when (= rule 0) (error "missing rule" (list state [tape pos])))
        (vector-set! tape pos [rule 0])
        (set! state [rule 2])
        (+= pos [rule 1])
;; end machine
        (when verbose (TM-trace  T tape pos state count )))
;; save TM state
    (set-TM-pos! T pos)
    (set-TM-state! T state)
    (when (= final state)  (writeln 'Stopping (TM-name T) 'at-pos (- pos (TM-mem T))))
    count)


[Attempt at Turing machine for Rosetta Code.]
[EDSAC program, Initial Orders 2.]

[Library subroutine M3 prints header and is then overwritten.]
            [email protected]@E8FEZPF
            *[email protected]&#..PZ [..PZ marks end of header]

            T48K    [& (delta) parameter: Turing machine tape.]
            P8F     [Overwrites most of initial orders.]

            T50K    [X parameter: once-only code.]
            P100F   [Gets overwritten by the Turing machine tape.]

[Put the following as high in memory as possible,
 to make room for the Turing machine tape.]
            T52K    [A parameter: rules and initial pattern. Also marks end]
            P781F   [of Turing tape, so must go immediately after tape area.]

            T55K    [V parameter: program-wide variables.]
            P810F   [Even address, 9 locations]

            T46K    [N parameter: constants.]
            P820F   [Even address]

            T47K    [M parameter: main routine.]
            P859F

            T51K    [G parameter: library subroutine P7]
            P988F   [Even address, 35 locations.]

[============================= A parameter ===============================]
            E25K TA GK
      [0] [End of Turing tape area]
[Comment-in the desired task, or add another (2 symbols only).]
[Counts are stored in the address field.]
[Each rule is defined by an EDSAC pseudo-order, as follows:
   Function letter: L = left, R = right, S = stay
   Address field = new state number
   Code letter: F if new symbol = 0, D if new symbol = 1.
 No rule is needed for the halt state.]
      [0]
[Simple incrementer: states are q0 = 0, qf = halt = 1
            P1F     [1 state, excluding the halt state
            S1D RD  [2 rules for each state (symbols 0 and 1)
            P1F     [1 word in tape area to be initialized
            PF P3D  [location 0 relative to tape, init to 7]
[3-state busy beaver: states are a = 0, b = 1, c = 2, halt = 3]
            P3F     [3 states, excluding the halt state]
            R1D L2D [2 rules for each state (symbols 0 and 1)]
            L0D R1D
            L1D S3D
            PF      [0 words to be initialized (start with empty tape)]
[5-state busy beaver: states are A = 0, ..., E = 4, halt = 5
            P5F     5 states, excluding the halt state
            R1D L2D 2 rules for each state (symbols 0 and 1)
            R2D R1D
            R3D L4F
            L0D L3D
            S5D L0F
            PF      0 words to be initialized (start with empty tape)]

[============================= X parameter ===============================]
            E25K TX GK
[The following once-only code is loaded into the Turing machine tape area.]
[It runs at start-up, then gets overwritten when the tape is cleared.]
[Enter with acc = 0.]
      [0]   T2V     [initial state assumed to be state 0]
            T3V     [tape head starts at position 0 on Turing tape]
            T#V     [reset count of steps]
            T4V     [initialize maximum position]
            T5V     [initialize minimum position]
[Calculate number of available tape positions; store in address field]
            A22N    [T order for exclusive end of tape]
            S21N    [T order for start of tape]
            L4F     [times 16, since each location holds 16 positions]
            T25N    [store for later use]
[Set up the loop in the main program that writes the initial pattern.
 The main program has a list of position-value pairs.
 This follows the list of rules, 2 rules per Turing machine state.]
      [9]   AA      [number of states]
            LD      [times 2, because 2 rules per state]
            A2F     [plus 1 for the count of states]
            [email protected]     [make A order to load number of position-value pairs]
            [email protected]    [plant order]
     [14]   AM      [load number of pairs (in address field)]
            LD      [times 2 for length of table]
            TF      [temp store in 0F]
            [email protected]    [load order that was planted above]
            A2F     [make order to load first position]
            U13M    [plant in main routine]
            AF      [make A order for exclusive end]
            T28M    [plant in main routine]
[Set up order to load rules]
            [email protected]
            A2F
            T18N
[Here with acc = 0. Jump to main routine.]
            EM
     [26]   AA

[============================= V parameter ===============================]
            E25K TV GK
      [0]   PFPF    [number of steps (35-bit, must be at even address)]
      [2]   PF      [current state of Turing machine]
      [3]   PF      [current tape position, stored in address field]
      [4]   PF      [maximum position on the tape so far]
      [5]   PF      [minimum position on the tape so far]
      [6]   PF      [rule for current state and symbol]
      [7]   PF      [working group of 16 cells (1 EDSAC location)]
      [8]   PF      [mask to select bit for current cell]

[============================= N parameter ===============================]
            E25K TN GK
[17-bit masks: 11111111111111110, 11111111111111101, ..., 10111111111111111]
      [0]   V2047F V2046D V2045D V2043D V2039D V2031D V2015D V1983D
            V1919D V1791D V1535D V1023D C2047D B2047D G2047D M2047D
     [16]   OF      [add to A order to make T order with same address]
     [17]   AN      [A order to load first mask in table]
     [18]   AF      [A order to load first rule]
     [19]   A&      [A order for start of tape]
     [20]   AA      [A order for end of tape]
     [21]   T&      [T order for start of tape]
     [22]   TA      [T order for exclusive end of tape]
     [23]   P2047F  [mask to pick out state from a Turing machine rule]
     [24]   P15F    [mask to extract bit number from position]
     [25]   PF      [number of tape positions available (calculated)]
     [26]   @F      [carriage return]
     [27]   &F      [line feed]
     [28]   K4096F  [null]
     [29]   K2048F  [set letters on teleprinter]

[============================= M parameter ===============================]
            E25K TM GK
[Once-only code jumps to here with acc = 0]
[Clear the tape; this overwrites the once-only code]
      [0]   A21N    [load T order for start of tape]
            [email protected]     [always jump (since T > 0)]
      [2]   A22N    [loop here after testing for end]
      [3]   [email protected]     [plant order to clear 1 location]
      [4]   TF      [execute order]
            [email protected]     [load order just executed]
            A2F     [inc address]
            S22N    [test for end]
            [email protected]     [if not end, loop back]
[Here with acc = 0]
[Set up the starting pattern, i.e write 1's at zero or more positions on the tape.]
[To save space, the orders marked (*) are set up by the once-only code.]
      [9]   [email protected]    [load A order for next relative addess]
            [email protected]    [compare with A order for exclusive end]
            [email protected]    [if all done, jump out with acc = 0]
            TF      [clear acc]
     [13]   AF      [(*) load relative address from table]
            [email protected]    [jump if < 0]
            A21N    [make T order, addr counted from low end of tape]
            [email protected]    [join commoon code (always jumps since T > 0)]
     [17]   A22N    [make T order, addr counted from high end of tape]
     [18]   [email protected]    [plant T order in code]
            [email protected]    [make order to load value from table]
            A2F
            [email protected]    [plant in code]
     [22]   AF      [load value from table]
     [23]   TF      [store in tape]
            [email protected]    [make A order for next address]
            A2F
            [email protected]    [plant in code]
            [email protected]     [always loop back]
     [28]   AF      [(*) A order for exclusive end of list]
     [29]
[Next step, i.e. set up new symbol, state and tape position.]
[Acc must be 0 here.]
[Get tape position and deduce corresponding EDSAC location and bit number.]
     [29]   H24N    [mask for bit number]
            C3V     [acc := bit number]
            UF      [save bit number in 0F address field]
            A17N    [make order to load from mask table]
            [email protected]    [plant order in code]
            A3V     [position]
            SF      [remove bit number part]
            R4F     [divide by 16 for relative address]
[If it's a non-negative address, add it to the start of the tape in EDSAC memory.]
[If it's a negative address, add it to the end of the tape.]
            [email protected]    [jump if negative address]
            A19N    [make A order to load from tape]
            [email protected]    [always jump to common code, since A < 0]
     [40]   A20N    [here if negative address]
     [41]   [email protected]    [store order to load current group of 16 bits]
            A16N    [convert to T order at same address]
            [email protected]    [store T order (a fair way down the code)]
     [44]   AF      [load mask]
            T8V
     [46]   AF      [load group]
            T7V
[Get rule for this state and symbol (where symbol = 0 or 1)]
            H8V
            C7V     [acc := bit group with current bit cleared]
            S7V     [acc := 0 if bit is 0, -1 if bit is 1]
            [email protected]
            TF      [clear acc]
            A2F     [to inc rule address if symbol is 1]
     [54]   A2V     [add state twice (because each state has 2 rules)]
            A2V
            A18N    [manufacture A order to load rule]
            [email protected]
     [58]   AF      [load rule]
            T6V     [to work space]
[Write new symbol (0 or 1) to tape. New symbol is in low bit of rule.]
            HN      [H register := 111...1110]
            C6V
            S6V     [result = 0 if new symbol is 0; -1 if it's 1]
            H8V     [H register = mask 1...101...1 for current bit]
            [email protected]    [jump to set the bit]
            C7V     [clear the bit]
            [email protected]    [always jump (because top bit in tape store is always 0)]
[Set bit, assuming acc = -1 here (reason why it works is a bit complicated)]
     [67]   C7V
            S8V
     [69]   TF      [manufactured order]
[Update position of tape head, i.e. inc by 1, dec by 1, or no change.]
[Move is in top 2 bits of rule, thus]
  [1x = move left, i.e. dec position (function letter can be L)]
  [00 = move right, i.e. inc position (function letter can be R)]
  [01 = stay, i.e. don't change position (function letter can be S)]
            A6V
            [email protected]    [left if top bit is 1]
     [72]   LD      [else test next bit]
            [email protected]    [skip move if next bit is 1]
     [74]   TF      [here to move right]
            A3V     [inc position]
            A2F
            U3V
[Here we update the maximum position if latest >= maximum.]
[This is unnecessary if latest = maximum, but code is simpler this way.]
            S4V     [test against maximum position]
            [email protected]    [skip if latest < maximum]
            A4V     [restore after test]
            T4V     [update maximum]
            [email protected]    [always jump, to check for overflow]
     [83]   TF      [here to move left]
            A3V     [dec position]
            S2F
     [86]   U3V
            S5V     [test against current minimum position]
            [email protected]    [jump if >= minimum]
            A5V     [restore acc after test]
            T5V     [update minimum]
[After updating maximum or minimum position, check that
   available memory hasn't been exceeded.]
     [91]   A4V     [maximum position]
            S5V     [subtract minimum position]
            S25N    [compare against number available]
            [email protected]   [jump out if overflow]
[The next order also serves as a constant]
     [95]   TF      [clear acc for next part]
[Increment the number of steps]
            A#V
            YFYF
            T#V
[Finally set the new state.]
    [100]   H23N    [mask for state bits in rule]
            C6V     [acc := new state]
            SA      [is it the last state?]
            [email protected]   [if yes, halt the Turing machine]
            AA      [restore acc after test]
            T2V     [update state]
            [email protected]    [loop back for next step]
[Overflow, i.e. non-negative tape positions (ascending in EDSAC memory)
 collide with negative tape positions (descending).]
    [107]   O29N    [set teleprinter to letters]
            [email protected] ON  [print 'OV' to indicate overflow]
            [email protected]   [jump to exit]
[Print number of steps]
    [111]   TF A#V  [clear accc, load number of steps]
            TD      [number of steps to 0D for print subroutine
    [114]   A114 @GG  [call print subroutine]
    [116]   O26N O27N [print CR, LF]
            O28N    [print null to flush teleprinter buffer]
            ZF      [stop]

[============================= G parameter ===============================]
            E25K TG
  [Library subroutine P7. 35 locations, even address. WWG page 18.]
  [Prints non-negative integer, up to 10 digits, right-justified.]
            [email protected]#@[email protected]@[email protected]@SFLDUFOFFFSFL4F
            T4D[email protected]@XFT28#[email protected][email protected]@

[========================== X parameter again ===============================]
            E25K TX GK
            EZ      [define entry point]
            PF      [enter with acc = 0]
[end]


#!/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}.


package turing

type Symbol byte

type Motion byte

const (
        Left  Motion = 'L'
        Right Motion = 'R'
        Stay  Motion = 'N'
)

type Tape struct {
        data      []Symbol
        pos, left int
        blank     Symbol
}

// NewTape returns a new tape filled with 'data' and position set to 'start'.
// 'start' does not need to be range, the tape will be extended if required.
func NewTape(blank Symbol, start int, data []Symbol) *Tape {
        t := &Tape{
                data:  data,
                blank: blank,
        }
        if start < 0 {
                t.Left(-start)
        }
        t.Right(start)
        return t
}

func (t *Tape) Stay()          {}
func (t *Tape) Data() []Symbol { return t.data[t.left:] }
func (t *Tape) Read() Symbol   { return t.data[t.pos] }
func (t *Tape) Write(s Symbol) { t.data[t.pos] = s }

func (t *Tape) Dup() *Tape {
        t2 := &Tape{
                data:  make([]Symbol, len(t.Data())),
                blank: t.blank,
        }
        copy(t2.data, t.Data())
        t2.pos = t.pos - t.left
        return t2
}

func (t *Tape) String() string {
        s := ""
        for i := t.left; i < len(t.data); i++ {
                b := t.data[i]
                if i == t.pos {
                        s += "[" + string(b) + "]"
                } else {
                        s += " " + string(b) + " "
                }
        }
        return s
}

func (t *Tape) Move(a Motion) {
        switch a {
        case Left:
                t.Left(1)
        case Right:
                t.Right(1)
        case Stay:
                t.Stay()
        }
}

const minSz = 16

func (t *Tape) Left(n int) {
        t.pos -= n
        if t.pos < 0 {
                // Extend left
                var sz int
                for sz = minSz; cap(t.data[t.left:])-t.pos >= sz; sz <<= 1 {
                }
                newd := make([]Symbol, sz)
                newl := len(newd) - cap(t.data[t.left:])
                n := copy(newd[newl:], t.data[t.left:])
                t.data = newd[:newl+n]
                t.pos += newl - t.left
                t.left = newl
        }
        if t.pos < t.left {
                if t.blank != 0 {
                        for i := t.pos; i < t.left; i++ {
                                t.data[i] = t.blank
                        }
                }
                t.left = t.pos
        }
}

func (t *Tape) Right(n int) {
        t.pos += n
        if t.pos >= cap(t.data) {
                // Extend right
                var sz int
                for sz = minSz; t.pos >= sz; sz <<= 1 {
                }
                newd := make([]Symbol, sz)
                n := copy(newd[t.left:], t.data[t.left:])
                t.data = newd[:t.left+n]
        }
        if i := len(t.data); t.pos >= i {
                t.data = t.data[:t.pos+1]
                if t.blank != 0 {
                        for ; i < len(t.data); i++ {
                                t.data[i] = t.blank
                        }
                }
        }
}

type State string

type Rule struct {
        State
        Symbol
        Write Symbol
        Motion
        Next State
}

func (i *Rule) key() key       { return key{i.State, i.Symbol} }
func (i *Rule) action() action { return action{i.Write, i.Motion, i.Next} }

type key struct {
        State
        Symbol
}

type action struct {
        write Symbol
        Motion
        next State
}

type Machine struct {
        tape         *Tape
        start, state State
        transition   map[key]action
        l            func(string, ...interface{}) // XXX
}

func NewMachine(rules []Rule) *Machine {
        m := &Machine{transition: make(map[key]action, len(rules))}
        if len(rules) > 0 {
                m.start = rules[0].State
        }
        for _, r := range rules {
                m.transition[r.key()] = r.action()
        }
        return m
}

func (m *Machine) Run(input *Tape) (int, *Tape) {
        m.tape = input.Dup()
        m.state = m.start
        for cnt := 0; ; cnt++ {
                if m.l != nil {
                        m.l("%3d %4s: %v\n", cnt, m.state, m.tape)
                }
                sym := m.tape.Read()
                act, ok := m.transition[key{m.state, sym}]
                if !ok {
                        return cnt, m.tape
                }
                m.tape.Write(act.write)
                m.tape.Move(act.Motion)
                m.state = act.next
        }
}


-- Some elementary types for Turing Machine
data Move = MLeft | MRight | Stay deriving (Show, Eq)
data Tape a = Tape a [a] [a]
data Action state val = Action val Move state deriving (Show)

instance (Show a) => Show (Tape a) where
  show (Tape x lts rts) = concat $ left ++ [hd] ++ right
                          where hd = "[" ++ show x ++ "]"
                                left = map show $ reverse $ take 10 lts
                                right = map show $ take 10 rts

-- new tape
tape blank lts rts | null rts = Tape blank left blanks
                   | otherwise = Tape (head rts) left right
                   where blanks = repeat blank
                         left = reverse lts ++ blanks
                         right = tail rts ++ blanks

-- Turing Machine
step rules (state, Tape x (lh:lts) (rh:rts)) = (state', tape')
     where  Action x' dir state' = rules state x
            tape' = move dir
            move Stay = Tape x' (lh:lts) (rh:rts)
            move MLeft = Tape lh lts (x':rh:rts)
            move MRight = Tape rh (x':lh:lts) rts

runUTM rules stop start tape = steps ++ [final]
      where (steps, final:_) = break ((== stop) . fst) $ iterate (step rules) (start, tape)


record TM(start,final,delta,tape,blank)
record delta(old_state, input_symbol, new_state, output_symbol, direction)

global start_tape
global show_count, full_display, trace_list  # trace flags

procedure main(args)
    init(args)
    runTuringMachine(get_tm())
end

procedure init(args)
    trace_list := ":"
    while arg := get(args) do {
        if arg == "-f" then full_display := "yes"
        else if match("-t",arg) then trace_list ||:= arg[3:0]||":"
        else show_count := integer(arg)
        }
end

procedure get_tm()
    D := table()

    writes("What is the start state? ")
    start := !&input
    writes("What are the final states (colon separated)? ")
    finals := !&input
    (finals||":") ? every insert(fStates := set(), 1(tab(upto(':')),move(1)))
    writes("What is the tape blank symbol?")
    blank := !&input

    write("Enter the delta mappings, using the following format:")
    write("\tenter delta(curState,tapeSymbol) = (newState,newSymbol,direct) as")
    write("\t   curState:tapeSymbol:newState:newSymbol:direct");
    write("\t\twhere direct is left, right, stay, or halt")
    write("End with a blank line.")
    write("")
    every line := !&input do {
        if *line = 0 then break
        line ?
             if (os := tab(upto(':')), move(1), ic := tab(upto(':')), move(1),
                 ns := tab(upto(':')), move(1), oc := tab(upto(':')), move(1),
                 d  := map(tab(0))) then D[os||":"||ic] := delta(os,ic,ns,oc,d)
             else write(line, " is in bad form, correct it")
        }
    if /start_tape then {
        write("Enter the input tape")
        start_tape := !&input
        }
    return TM(start,fStates,D,start_tape,blank)
end

procedure runTuringMachine(tm)
    trans := tm.delta
    rightside := tm.tape
    if /rightside | (*rightside = 0) then rightside := tm.blank
    leftside := ""

    cur_state := tm.start
    write("Machine starts in ",cur_state," with tape:")
    show_tape(tm,leftside,rightside)
    while mapping := \trans[cur_state||":"||rightside[1]] do {
        rightside[1] := mapping.output_symbol
        case mapping.direction of {
            "left" : {
                 if *leftside = 0 then leftside := tm.blank
                 rightside := leftside[-1] || rightside
                 leftside[-1] := ""
                 }
            "right" : {
                 leftside ||:= rightside[1]
                 rightside[1] := ""
                 if *rightside = 0 then rightside := tm.blank
                 }
            "halt" : break
            }
        cur_state := mapping.new_state
        if member(tm.final,cur_state) then break
        trace(tm,cur_state,leftside,rightside)
        }
    write()
    write("Machine halts in ",cur_state," with tape:")
    show_tape(tm,leftside,rightside)
end

procedure trace(tm,cs,ls,rs)
    static count, last_state
    initial {
       count := 0
       last_state := ""
       }

    count +:= 1
    if \show_count & (count % show_count = 0) then show_tape(tm,ls,rs)
    if find(":"||cs||":",trace_list) & (last_state ~== cs) then {
        writes("\tnow in state: ",cs," ")
        if \full_display then show_delta(tm.delta[cs||":"||rs[1]])
        else write()
        }
    last_state := cs
    return
end

procedure show_delta(m)
    if /m then write("NO MOVE!")
    else {
        writes("\tnext move is ")
        writes("delta(",m.old_state,",",m.input_symbol,") ::= ")
        write("(",m.new_state,",",m.output_symbol,",",m.direction,")")
        }
end

procedure show_tape(tm,l,r)
    l := reverse(trim(reverse(l),tm.blank))
    r := trim(r,tm.blank)
    write(l,r)
    write(repl(" ",*l),"^")
end


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");
    }
}


import Base.show

@enum Move Left=1 Stay Right

mutable struct MachineState
    state::String
    tape::Dict{Int, String}
    headpos::Int
end

struct Rule
    instate::String
    s1::String
    s2::String
    move::Move
    outstate::String
end

struct Program
    title::String
    initial::String
    final::String
    blank::String
    rules::Vector{Rule}
end

const testprograms = [
    (Program("Simple incrementer", "q0", "qf", "B",
        [Rule("q0", "1", "1", Right, "q0"), Rule("q0", "B", "1", Stay, "qf")]),
     Dict(1 =>"1", 2 => "1", 3 => "1"), true),
    (Program("Three-state busy beaver", "a", "halt", "0",
        [Rule("a", "0", "1", Right, "b"), Rule("a", "1", "1", Left, "c"),
         Rule("b", "0", "1", Left, "a"), Rule("b", "1", "1", Right, "b"),
         Rule("c", "0", "1", Left, "b"), Rule("c", "1", "1", Stay, "halt")]),
     Dict(), true),
    (Program("Five-state busy beaver", "A", "H", "0",
        [Rule("A", "0", "1", Right, "B"), Rule("A", "1", "1", Left, "C"),
         Rule("B", "0", "1", Right, "C"), Rule("B", "1", "1", Right, "B"),
         Rule("C", "0", "1", Right, "D"), Rule("C", "1", "0", Left, "E"),
         Rule("D", "0", "1", Left, "A"), Rule("D", "1", "1", Left, "D"),
         Rule("E", "0", "1", Stay, "H"), Rule("E", "1", "0", Left, "A")]),
     Dict(), false)]

function show(io::IO, mstate::MachineState)
    ibracket(i, curpos, val) = (i == curpos) ? "[$val]" : " $val "
    print(io, rpad("($(mstate.state))", 12))
    for i in sort(collect(keys(mstate.tape)))
        print(io, "   $(ibracket(i, mstate.headpos, mstate.tape[i]))")
    end
end

function turing(program, tape, verbose)
    println("\n$(program.title)")
    verbose && println(" State       \tTape [head]\n--------------------------------------------------")
    mstate = MachineState(program.initial, tape, 1)
    stepcount = 0
    while true
        if !haskey(mstate.tape, mstate.headpos)
            mstate.tape[mstate.headpos] = program.blank
        end
        verbose && println(mstate)
        for rule in program.rules
            if rule.instate == mstate.state && rule.s1 == mstate.tape[mstate.headpos]
                mstate.tape[mstate.headpos] = rule.s2
                if rule.move == Left
                    mstate.headpos -= 1
                elseif rule.move == Right
                    mstate.headpos += 1
                end
                mstate.state = rule.outstate
                break
            end
        end
        stepcount += 1
        if mstate.state == program.final
            break
        end
    end
    verbose && println(mstate)
    println("Total steps: $stepcount")
end

for (prog, tape, verbose) in testprograms
        turing(prog, tape, verbose)
end


// version 1.2.10

enum class Dir { LEFT, RIGHT, STAY }

class Rule(
    val state1: String,
    val symbol1: Char,
    val symbol2: Char,
    val dir: Dir,
    val state2: String
)

class Tape(
    var symbol: Char,
    var left: Tape? = null,
    var right: Tape? = null
)

class Turing(
    val states: List<String>,
    val finalStates: List<String>,
    val symbols: CharArray,
    val blank: Char,
    var state: String,
    tapeInput: CharArray,
    rules: List<Rule>
) {
    var tape: Tape? = null
    val transitions = Array(states.size) { arrayOfNulls<Rule>(symbols.size) }

    init {
        for (i in 0 until tapeInput.size) {
            move(Dir.RIGHT)
            tape!!.symbol = tapeInput[i]
        }
        if (tapeInput.size == 0) move(Dir.RIGHT)
        while (tape!!.left != null) tape = tape!!.left
        for (i in 0 until rules.size) {
            val rule = rules[i]
            transitions[stateIndex(rule.state1)][symbolIndex(rule.symbol1)] = rule
        }
    }

    private fun stateIndex(state: String): Int {
        val i = states.indexOf(state)
        return if (i >= 0) i else 0
    }

    private fun symbolIndex(symbol: Char): Int {
        val i = symbols.indexOf(symbol)
        return if (i >= 0) i else 0
    }

    private fun move(dir: Dir) {
        val orig = tape
        when (dir) {
            Dir.RIGHT -> {
                if (orig != null && orig.right != null) {
                    tape = orig.right
                }
                else {
                    tape = Tape(blank)
                    if (orig != null) {
                        tape!!.left = orig
                        orig.right = tape
                    }
                }
            }

            Dir.LEFT -> {
                if (orig != null && orig.left != null) {
                    tape = orig.left
                }
                else {
                    tape = Tape(blank)
                    if (orig != null) {
                        tape!!.right = orig
                        orig.left = tape
                    }
                }
            }

            Dir.STAY -> {}
        }
    }

    fun printState() {
        print("%-10s ".format(state))
        var t = tape
        while (t!!.left != null ) t = t.left
        while (t != null) {
            if (t == tape) print("[${t.symbol}]")
            else           print(" ${t.symbol} ")
            t = t.right
        }
        println()
    }

    fun run(maxLines: Int = 20) {
        var lines = 0
        while (true) {
            printState()
            for (finalState in finalStates) {
                if (finalState == state) return
            }
            if (++lines == maxLines) {
                println("(Only the first $maxLines lines displayed)")
                return
            }
            val rule = transitions[stateIndex(state)][symbolIndex(tape!!.symbol)]
            tape!!.symbol = rule!!.symbol2
            move(rule.dir)
            state = rule.state2
        }
    }
}

fun main(args: Array<String>) {
    println("Simple incrementer")
    Turing(
        states      = listOf("q0", "qf"),
        finalStates = listOf("qf"),
        symbols     = charArrayOf('B', '1'),
        blank       = 'B',
        state       = "q0",
        tapeInput   = charArrayOf('1', '1', '1'),
        rules       = listOf(
            Rule("q0", '1', '1', Dir.RIGHT, "q0"),
            Rule("q0", 'B', '1', Dir.STAY, "qf")
        )
    ).run()

    println("\nThree-state busy beaver")
    Turing(
        states      = listOf("a", "b", "c", "halt"),
        finalStates = listOf("halt"),
        symbols     = charArrayOf('0', '1'),
        blank       = '0',
        state       = "a",
        tapeInput   = charArrayOf(),
        rules       = listOf(
            Rule("a", '0', '1', Dir.RIGHT, "b"),
            Rule("a", '1', '1', Dir.LEFT, "c"),
            Rule("b", '0', '1', Dir.LEFT, "a"),
            Rule("b", '1', '1', Dir.RIGHT, "b"),
            Rule("c", '0', '1', Dir.LEFT, "b"),
            Rule("c", '1', '1', Dir.STAY, "halt")
        )
    ).run()

    println("\nFive-state two-symbol probable busy beaver")
    Turing(
        states      = listOf("A", "B", "C", "D", "E", "H"),
        finalStates = listOf("H"),
        symbols     = charArrayOf('0', '1'),
        blank       = '0',
        state       = "A",
        tapeInput   = charArrayOf(),
        rules       = listOf(
            Rule("A", '0', '1', Dir.RIGHT, "B"),
            Rule("A", '1', '1', Dir.LEFT, "C"),
            Rule("B", '0', '1', Dir.RIGHT, "C"),
            Rule("B", '1', '1', Dir.RIGHT, "B"),
            Rule("C", '0', '1', Dir.RIGHT, "D"),
            Rule("C", '1', '0', Dir.LEFT, "E"),
            Rule("D", '0', '1', Dir.LEFT, "A"),
            Rule("D", '1', '1', Dir.LEFT, "D"),
            Rule("E", '0', '1', Dir.STAY, "H"),
            Rule("E", '1', '0', Dir.LEFT, "A")
        )
    ).run()
}


{require lib_H}  // associative arrays library

{def tm
 {def tm.r
  {lambda {:data :rules :state :end :blank :i :N}
   {if {or {W.equal? :state :end} {> :N 400}}        // recursion limited to 400
    then :data
    else {let { {:data :data} {:rules :rules}
                {:state {H.get :state :rules}}
                {:end :end} {:blank :blank}
                {:i :i} {:N :N}
                {:cell {if {W.equal? {A.get :i :data} undefined}
                        then :blank
                        else {A.get :i :data}}}
              } {tm.r {A.set! :i {H.get write {H.get :cell :state}} :data}
                      :rules
                      {H.get next {H.get :cell :state}}
                      :end
                      :blank
                      {+ :i {H.get move {H.get :cell :state}} }
                      {+ :N 1} } }}}}
 {lambda {:name :data :rules :state :end :blank}
    :name: {A.duplicate :data} ->
    {tm.r :data :rules :state :end :blank 0 0}}}
-> tm

{tm zero2one
    {A.new 0 0 0}
    {H.new A {H.new 0 {H.new write 1 | move 1 | next A} |
                    B {H.new write . | move 1 | next H} }
    } A H B}

output: zero2one: [0,0,0] -> [1,1,1,.]

{tm add_one
    {A.new 1 1 1}
    {H.new A {H.new 1 {H.new write 1 | move 1 | next A} |
                    B {H.new write 1 | move 0 | next B} }
    } A B B}

output: add_one: [1,1,1] -> [1,1,1,1]

{tm unary_adder
    {A.new 1 1 1 0 1 1 1}
    {H.new A {H.new 1 {H.new write 0 | move 1 | next B} } |
           B {H.new 1 {H.new write 1 | move 1 | next B} |
                    0 {H.new write 1 | move 0 | next H} }
    } A H B}

output: unary_adder: [1,1,1,0,1,1,1] -> [0,1,1,1,1,1,1]

{tm duplicate
    {A.new 1 1 1}
    {H.new q0 {H.new 1 {H.new write B | move 1 | next q1} } |

           q1 {H.new 1 {H.new write 1 | move  1 | next q1} |
                     0 {H.new write 0 | move  1 | next q2} |
                     B {H.new write 0 | move  1 | next q2}} |

           q2 {H.new 1 {H.new write 1 | move  1 | next q2} |
                     B {H.new write 1 | move -1 | next q3}} |

           q3 {H.new 1 {H.new write 1 | move -1 | next q3} |
                     0 {H.new write 0 | move -1 | next q3} |
                     B {H.new write 1 | move  1 | next q4}} |

           q4 {H.new 1 {H.new write B | move  1 | next q1} |
                     0 {H.new write 0 | move  1 | next qf}}
    } q0 qf B}

output: duplicate: [1,1,1] -> [1,1,1,0,1,1,1]

{tm sort
    {A.new 2 1 2 2 2 1 1}
    {H.new A {H.new 1 {H.new write 1 | move  1 | next A} |
                    2 {H.new write 3 | move  1 | next B} |
                    0 {H.new write 0 | move -1 | next E}} |

           B {H.new 1 {H.new write 1 | move  1 | next B} |
                    2 {H.new write 2 | move  1 | next B} |
                    0 {H.new write 0 | move -1 | next C}} |

           C {H.new 1 {H.new write 2 | move -1 | next D} |
                    2 {H.new write 2 | move -1 | next C} |
                    3 {H.new write 2 | move -1 | next E}} |

           D {H.new 1 {H.new write 1 | move -1 | next D} |
                    2 {H.new write 2 | move -1 | next D} |
                    3 {H.new write 1 | move  1 | next A}} |

           E {H.new 1 {H.new write 1 | move -1 | next E} |
                    0 {H.new write 0 | move  1 | next H}}
    } A H 0}

output: sort: [2,1,2,2,2,1,1] -> [1,1,1,2,2,2,2,0]

{tm busy_beaver
    {A.new}
    {H.new A {H.new 0 {H.new write 1 | move  1 | next B} |
                    1 {H.new write 1 | move -1 | next C}} |

           B {H.new 0 {H.new write 1 | move -1 | next A} |
                    1 {H.new write 1 | move  1 | next B}} |

           C {H.new 0 {H.new write 1 | move -1 | next B} |
                    1 {H.new write 1 | move  0 | next H}}
    } A H 0}

output: busy_beaver: [] -> [1,1,1]

{tm busy_beaver2
    {A.new}
    {H.new A {H.new 0 {H.new write 1 | move  1 | next B} |
                    1 {H.new write 1 | move -1 | next C}} |

           B {H.new 0 {H.new write 1 | move  1 | next C} |
                    1 {H.new write 1 | move  1 | next B}} |

           C {H.new 0 {H.new write 1 | move  1 | next D} |
                    1 {H.new write 0 | move -1 | next E}} |

           D {H.new 0 {H.new write 1 | move -1 | next A} |
                    1 {H.new write 1 | move -1 | next D}} |

           E {H.new 0 {H.new write 1 | move  0 | next K} |
                    1 {H.new write 0 | move -1 | next A}}
   } A K 0}

output: busy_beaver2: [] -> [1,1,1,1,1,1,1,1,1,1,1]


-- Machine definitions
local incrementer = {
    name = "Simple incrementer",
    initState = "q0",
    endState = "qf",
    blank = "B",
    rules = {
        {"q0", "1", "1", "right", "q0"},
        {"q0", "B", "1", "stay", "qf"}
    }
}

local threeStateBB = {
    name = "Three-state busy beaver",
    initState = "a",
    endState = "halt",
    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"}
    }
}

local fiveStateBB = {
    name = "Five-state busy beaver",
    initState = "A",
    endState = "H",
    blank = "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"}
    }
}

-- Display a representation of the tape and machine state on the screen
function show (state, headPos, tape)
    local leftEdge = 1
    while tape[leftEdge - 1] do leftEdge = leftEdge - 1 end
    io.write(" " .. state .. "\t| ")
    for pos = leftEdge, #tape do
        if pos == headPos then io.write("[" .. tape[pos] .. "] ") else io.write(" " .. tape[pos] .. "  ") end
    end
    print()
end

-- Simulate a turing machine
function UTM (machine, tape, countOnly)
    local state, headPos, counter = machine.initState, 1, 0
    print("\n\n" .. machine.name)
    print(string.rep("=", #machine.name) .. "\n")
    if not countOnly then print(" State", "| Tape [head]\n---------------------") end
    repeat
        if not tape[headPos] then tape[headPos] = machine.blank end
        if not countOnly then show(state, headPos, tape) end
        for _, rule in ipairs(machine.rules) do
            if rule[1] == state and rule[2] == tape[headPos] then
                tape[headPos] = rule[3]
                if rule[4] == "left" then headPos = headPos - 1 end
                if rule[4] == "right" then headPos = headPos + 1 end
                state = rule[5]
                break
            end
        end
        counter = counter + 1
    until state == machine.endState
    if countOnly then print("Steps taken: " .. counter) else show(state, headPos, tape) end
end

-- Main procedure
UTM(incrementer, {"1", "1", "1"})
UTM(threeStateBB, {})
UTM(fiveStateBB, {}, "countOnly")


left = 1; right = -1; stay = 0;
cmp[s_] := ToExpression[StringSplit[s, ","]];
utm[rules_, initial_, head_] :=
  Module[{tape = initial, rh = head, n = 1},
   Clear[nxt];
   nxt[state_, field_] :=
    nxt[state, field] = Position[rules, {rules[[state, 5]], field, _, _, _}][[1, 1]];
   n = Position[rules, {rules[[n, 1]], BitGet[tape, rh], _, _, _}][[1,1]];
   While[rules[[n, 4]] != 0,
    If[rules[[n, 3]] != BitGet[tape, rh],
     If[rules[[n, 3]] == 1, tape = BitSet[tape, rh],
      tape = BitClear[tape, rh]]];
    rh = rh + rules[[n, 4]];
    If[rh < 0, rh = 0; tape = 2*tape];
    n = nxt[n, BitGet[tape, rh]];
    ]; {tape, rh}
   ];
];


function tape=turing(rules,tape,initial,terminal)
    %"rules" is cell array of cell arrays of the following form:
    %First element is number representing initial state
    %Second element is number representing input from the tape
    %Third element is number representing output printed onto the tape
    %Fourth element is 'l', 'r', or 's' representing whether to go right,
    %left, or stay. Treats any input other than 'l' or 'r' as 's'.
    %Final value is state we go to
    %0 is always blank symbol
    term=0;
    ind=1;
    while term==0
        a=[];
        for i=1:numel(rules)
            if rules{i}{1}==initial
                a=[a i];
            end
        end

        possible=rules(a);
        n=numel(possible);

        while numel(tape)<ind
            tape=[tape, 0]; %#ok<AGROW>
        end

        for i=1:n
            if(tape(ind)==possible{i}{2})
                break;
            end
        end
        instruction=possible{i};
        tape(ind)=instruction{3};
        if instruction{4}=='r'
            ind=ind+1;
        elseif instruction{4}=='l'
            if ind==1
                tape=[0,tape]; %#ok<AGROW>
            else
                ind=ind-1;
            end
        end
        if terminal==instruction{5}
            term=1;
        else
            initial=instruction{5};
        end
    end
end


:- 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([email protected](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([email protected](_, Halts, Blank), Rules, State,
        [email protected](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).