% Turing machine simulator using Prolog
% by Robert Keller

% This code was mostly transcribed from the Scheme implementation, tmsim.scm

% Turing machine representation:
% A TM is represented as a list of 5-tuples, where each 5-tuple is:
%
% (current-state current-symbol-read symbol-written motion next-state)
%
% By convention, the curent-state of the first 5-tuple is the initial state.
%
% Names of states and symbols is arbitrary, except that we have a
% fixed convention for the blank symbol, using the symbol defined next:

blank('_').

% Symbols for head motion are defined here:

left('L').
right('R').
none('N').

% In a deterministic TM there is at most one next-state, symbol-written, and head motion
% for a given current-state current-symbol-read. However, there also might be none.
% In this case, a combination for which there is no next-state, etc. is considered  
% to be a halting state.

% Our version of a TM has a two-way unbounded tape.
% Initially the head is assumed to be positioned at the left end of the input.
% The argument to tmsim is a list representing this portion of the tape.
% At the end, the result is assumed to be whatever is on the tape. 
% The result of tmsim is a list of 3 elements: 
%    The part of the tape to the left of the head, with leading blanks removed.
%    The control state when the machine stops.
%    The part of the tape to the right of the head, with trailing blanks removed.

tmsim(Machine, Initial_Tape, Result) :-
    Machine = [(Initial_Control_State, _,  _, _, _) | _],
    tmsim_helper(Machine, Initial_Control_State, [], Initial_Tape, Result).


% Predicate tmsim-helper simulates the behavior of a machine from its
% current state and tape to the completion of the computation, if there
% is a completion.
%
% Note that left-tape is the tape from the left of the head leftward,
% so it reads in the opposite direction from right-tape.
% This is a matter of convenience in manipulating the tape.

tmsim_helper(Machine, Current_State, LeftTape, RightTape, Result) :-
    first_symbol(RightTape, Symbol_Read, Remaining_to_Right),
    member((Current_State, Symbol_Read, Symbol_Written, Motion, Next_State), Machine) ->
      (
      right(Motion) ->

          tmsim_helper(Machine, Next_State, [Symbol_Written | LeftTape], Remaining_to_Right, Result)

     ; left(Motion) ->

        first_symbol(LeftTape, Symbol_to_Left, Remaining_to_Left),
        tmsim_helper(Machine, Next_State, Remaining_to_Left, [Symbol_to_Left, Symbol_Written | Remaining_to_Right], Result)

    ; none(Motion) ->

        tmsim_helper(Machine, Next_State, LeftTape, [Symbol_Written | Remaining_to_Right], Result)
    )

     ; final(Current_State, LeftTape, RightTape, Result).    % no next-state specified


% decompose a tape into a symbol and a list of symbols.
% If the tape is empty, introduce a blank symbol

first_symbol([F | R], F, R).
first_symbol([], Blank, []) :- blank(Blank).


% Predicate final packages the final state as a 3-element list,
% the left part of the tape in proper orientation (rather than reversed
% as is used in the simulation), the final state, and the right part of
% the tape.

final(Current_State, LeftTape, RightTape, Result) :-
    reverse(LeftTape, Left),
    drop_leading_blanks(Left, CleanedLeft),
    drop_trailing_blanks(RightTape, CleanedRight),
    append(CleanedLeft, [Current_State | CleanedRight], Result).


% drop_trailing_blanks removes any trailing blanks from its argument

drop_trailing_blanks(List, Result) :-
    reverse(List, Reversed),
    drop_leading_blanks(Reversed, Cleaned),
    reverse(Cleaned, Result).

% drop_leading_blanks removes any leading blanks from its argument

drop_leading_blanks([], []).

drop_leading_blanks([X | More], Result) :-
    blank(X) ->
      drop_leading_blanks(More, Result)
    ; Result = [X | More].


% Test program that runs a named machine on a tape,
% and compares the result with what was expected

test(MachinePredicate, Tape, Expected) :-
  write('   name '), write(MachinePredicate), nl,
  Goal =.. [MachinePredicate, Machine],
  call(Goal),
  write(' tuples '), nl,
  list_tuples(Machine), nl,
  write('   tape '), write(Tape), nl,
  tmsim(Machine, Tape, Result),
  write(' result '), write(Result), nl,
  (
  Result = Expected ->
    write('success '), nl, nl
  ; write('*** fails, expected '), write(Expected), nl, nl
  ).

list_tuples([]).

list_tuples([A | X]) :-
    write('        '), write(A), nl,
    list_tuples(X).

% add1-1adic is a TM that adds 1 to the 1-adic representation of a number.
% In this representation, the number n is represented by a list of n 1's.
% Number 0 is represented by the empty list.

add1_1adic(
  [(start,   '_', 1, 'N', stop),
   (start,    1, 1, 'L', deposit),
   (deposit, '_', 1, 'N', stop)]).

test1(1) :- test(add1_1adic, [1, 1, 1], [stop, 1, 1, 1, 1]).

test1(2) :- test(add1_1adic, [1, 1, 1, 1, 1, 1, 1], [stop, 1, 1, 1, 1, 1, 1, 1, 1]).

test1(3) :- test(add1_1adic, [1], [stop, 1, 1]).

test1(4) :- test(add1_1adic, [], [stop, 1]).

% add1-binary is a TM that adds 1 to the binary representation of a number,
% most-significant bit first.
%
% With the head positioned at the left end of the tape, it moves to the
% right end, staying in state 'start. 
% The right end is sensed by encountering a blank, taking the machine to state 'adding.
% The head then moves left to the rightmost 0, or blank if there is no 0, all the while
% in state 'adding. As it moves, 1's are replaced with 0's.
% When the rightmost 0 is encountered, it is replaced with a 1 and 'finishing is entered.
% If there is no 0, then _ will be reached, and it will be replaced with a 1, then the
% machine stops.
% In state 'finishing, the machine moves to the left toward the end, and stops when a _
% is encountered.

add1_binary(
  [
    (start,           0, 0, R, start),       % Move right to _, leaving other symbols as is.
    (start,           1, 1, R, start),
    (start,           B, _, L, adding),      % First _ to the right encountered, start moving left.
    
    (adding,          B, 1, N, stop),        % Move left to 0 or _, replacing 1's with 0's.
    (adding,          0, 1, L, finishing),   % Upon encountering a 0 or _, a 1 is written,
    (adding,          1, 0, L, adding),      % then the computation finishes up.
    
    (finishing,       0, 0, L, finishing),   % Move left to _, leaving symbols as is, then stop.
    (finishing,       1, 1, L, finishing),
    (finishing,       B, B, R, stop)        
  ]) :-
  blank(B),
  left(L),
  right(R),
  none(N).


test2(1) :- test(add1_binary, [1, 0, 0, 1], [stop, 1, 0, 1, 0]).

test2(2) :- test(add1_binary, [1, 0, 0, 1, 1], [stop, 1, 0, 1, 0, 0]).

test2(3) :- test(add1_binary, [1, 1, 1, 1], [stop, 1, 0, 0, 0, 0]).

test2(4) :- test(add1_binary, [0], [stop, 1]).

test2(5) :- test(add1_binary, [1], [stop, 1, 0]).

test2(6) :- test(add1_binary, [0, 0, 0, 0, 0], [stop, 0, 0, 0, 0, 1]).

% Below is an example of a Busy-Beaver machine. 
% The objective is, with a given number of states, and only two tape symbols, 1 and _ say,
% write as many 1's as possible, then halt. 
% The winner of the Busy-Beaver(n) competition is the n-state machine that writes the most 1's.

% busy4 happens to be the winner of Busy-Beaver(4).

busy4([
    (a, B, 1, R, b),
    (a, 1, 1, L, b),
    (b, B, 1, L, a),
    (b, 1, B, L, d),
    (c, B, 1, R, c),
    (c, 1, B, R, a),
    (d, B, 1, R, stop),
    (d, 1, 1, L, c)
    ]) :-
    blank(B),
    left(L),
    right(R).

test3(1) :- test(busy4, [], [1, stop, '_', 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1]).

% This Busy-Beaver(5) contestant stops with 4098 1's on its tape. 
% The winner of Busy-Beaver(5) is not yet known. 

busy5([
    (1, B, 1, R, 2),
    (1, 1, 1, R, 1),
    (2, B, 1, L, 3),
    (2, 1, 1, L, 2),
    (3, B, 1, R, 1),
    (3, 1, 1, L, 4),
    (4, B, 1, R, 1),
    (4, 1, 1, L, 5),
    (5, B, 1, L, 0),
    (5, 1, B, L, 3)
    ]) :-
    blank(B),
    left(L),
    right(R).

test4(1) :- 
  test(busy5, [], Result), 
  count1s(Result, L),
  write('There are '), write(L), write(' 1''s on the tape.'), nl.


% count the number of 1's in a list.

count1s(L, Result) :- count1s(L, 0, Result).

% auxiliary predicate:
% Note that an accumulator is used.

count1s([], Acc, Acc).

count1s([C | X], Acc, Result) :-
   (
   C == 1 -> 
      A1 is Acc + 1
    ; A1 is Acc
    ),
  count1s(X, A1, Result).


test :- test1(_), fail.
test :- test2(_), fail.
test :- test3(_), fail.
test :- test4(_), fail.
test.