% file: tmSim.pro
% Turing machine computation
% author: Robert Keller
% This particular implementation was adapted from http://en.wikipedia.org/wiki/Prolog

% compute(InitialTape, FinalTape, Rules) carries out a TM computation
% according to the list of rules Rules
% InitialTape is the tape at the start. 
% The head is assumed to be at the left of the non-blank input.
% FinalTape is the tape at completion

% Assumptions on symbols:
%     q0 designates the initial state
%     qf designates the (one-and-only) halting state.
%     b is the blank tape symbol
%     The head motion choices are {left, stay, right}.
%
% Rules is a list of 5-tuples of the form 
%    (CurrentState, SymbolRead, NextState, SymbolWritten, Motion).


compute(InitialTape, FinalTape, Rules) :-
    simulate(q0, [], InitialTape, LeftReverse, Right, Rules),
    reverse(LeftReverse, Left),
    append(Left, Right, FinalTape).
 
show(InitialTape, FinalTape, Rules) :-
    showState([], q0, InitialTape),
    simulateShowing(q0, [], InitialTape, LeftReverse, Right, Rules),
    reverse(LeftReverse, Left),
    append(Left, Right, FinalTape).

simulateShowing(qf, Left, Right, Left, Right, _Rules).
simulateShowing(Q0, Left0, Right0, Left, Right, Rules) :-
    step(Q0, Left0, Right0, Q1, Left1, Right1, Rules),
    showState(Left1, Q1, Right1),
    simulateShowing(Q1, Left1, Right1, Left, Right, Rules).

showState(Left, Q, Right) :-
    reverse(Left, LeftR),
    write(LeftR), write(' '), write(Q), write(' '), write(Right), nl.


% In all of the following rules, the left part of the tape 
% is a list in reverse order from the head, so that
% the symbol nearest the head is immediately accessible in a Prolog list.

% simulate(Q0, Left0, Right0, Left, Right, Rules) simulates multiple steps of the TM
% starting in control state Q0 with tape Left0, Right0
% and ending in control state Qf with tape Left, Right.

simulate(qf, Left, Right, Left, Right, _Rules).
simulate(Q0, Left0, Right0, Left, Right, Rules) :-
    step(Q0, Left0, Right0, Q1, Left1, Right1, Rules),
    simulate(Q1, Left1, Right1, Left, Right, Rules).


% step(Q0, Left0, Right0, Q1, Left1, Right1, Rules) simulates one step of the TM
% from control state Q0 and tape Left0, Right0, to 
% control state Q1 and tape Left1, Right1

step(Q0, Left0, Right0, Q1, Left1, Right1, Rules) :-
    symbol(Right0, Sym, RightRest),
    member((Q0, Sym, Q1, NewSym, Action), Rules),
    action(Action, Left0, Left1, [NewSym|RightRest], Right1).
 

% symbol(Right0, Sym, RightRest) gets the symbol to the right of the TM head.
% In case the right portion of the tape is empty, it generates a blank symbol b.

symbol([], b, []).
symbol([Symbol|Right], Symbol, Right).
 

% action(Motion, Left, Left, Right, Right) simulates the tape head mtion
% Motion must be one of {left, stay, right}

action(left, Left0, Left, Right0, Right) :- left(Left0, Left, Right0, Right).
action(stay, Left, Left, Right, Right).
action(right, Left0, [Sym|Left0], [Sym|Right], Right).
 
left([], [], Right0, [b|Right0]).
left([L|Left], Left, Right, [L|Right]).

add1Rules([(q0, 1, q0, 1, right), (q0, b, qf, 1, stay)]).

bb3Rules([
    (q0, b, q1, 1, right),
    (q0, 1, q2, 1, left),

    (q1, b, q0, 1, left),
    (q1, 1, q1, 1, right),

    (q2, b, q1, 1, left),
    (q2, 1, qf, 1, right)
    ]).

testAdd1 :-
  write('add1'),
  nl,
  add1Rules(Rules),
  show([1, 1, 1, 1], Ans, Rules),
  write(Ans),
  nl.

testBB3 :-
  write('BB3'),
  nl,
  bb3Rules(Rules),
  show([], Ans, Rules),
  write(Ans),
  nl.


test :- 
    testAdd1,
    testBB3.