Pull to refresh

Prolog. Программируем автоматы

Reading time 6 min
Views 5.6K
Прочитав статью о Prolog, я решил написать небольшое дополнение к ней в виде 2 небольших задач.
Вот они:
1. Интерпретатор языка brainfuck
2. Машина Тьюринга

Для начала нам требуется SWI-Prolog и немного свободного времени.

Задача 1. Интерпритатор языка brainfuck

Начнем с копи-паста из Википедии.
Brainfuck — один из известнейших эзотерических языков программирования, придуман Урбаном Мюллером в 1993 году для забавы. Язык имеет восемь команд, каждая из которых записывается одним символом. Исходный код программы на Brainfuck представляет собой последовательность этих символов без какого-либо дополнительного синтаксиса.
Машина, которой управляют команды Brainfuck, состоит из упорядоченного набора ячеек и указателя текущей ячейки, напоминая ленту и головку машины Тьюринга. Кроме того, подразумевается устройство общения с внешним миром (см. команды. и ,) через поток ввода и поток вывода.

Команды и их описание:

  • > перейти к следующей ячейке
  • < перейти к предыдущей ячейке
  • + увеличить значение в текущей ячейке на 1
  • — уменьшить значение в текущей ячейке на 1
  • . напечатать значение из текущей ячейки
  • , ввести извне значение и сохранить в текущей ячейке
  • [ если значение текущей ячейки нуль, перейти вперёд по тексту программы на ячейку, следующую за соответствующей ] (с учётом вложенности)
  • ] если значение текущей ячейки не нуль, перейти назад по тексту программы на символ [ (с учётом вложенности)


Лента представленна в виде базы данных
data(Адресс, Значение).
Головка представлена адрессом ячейки
pos(Адресс).

Собственно код с комментариями:
% ,        
cout:-
        %получаем адресс текщей ячейки
        pos(Addr),
        %получаем значение
        data(Addr,Value),
        %выводим его на экран
        put_char([Value]).
% .
cin:-
        %получаем адресс текущей ячейки
        pos(Addr),
        %удаляем ячейку из базы
        retract(data(Addr,_)),
        %читаем символ
        get_single_char(Value),
        %записываем назад в базу
        assert(data(Addr,Value)).
% + -
add(AddValue):-
        %получаем адресс
        pos(Addr),
        %удаляем ячейку
        retract(data(Addr,Value)),
        %увеличиваем значение на 1		
        NewValue is Value+AddValue,
        %заносим новую ячейку
        assert(data(Addr,NewValue)).
% > <
addr(Side):-
        %удаляем текущий адресс
        retract(pos(Addr)),
        %инкрементриуем значение адресса
        NewAddr is Addr+Side,
        %заносим новое значение в базу
        assert(pos(NewAddr)),
        %ячейка была в базу или создаем новую
        (data(NewAddr,_),!;assert(data(NewAddr,0))).

% ]
goto:-
        %получаем адресс
        pos(Addr),
        %получаем значение и проверяем на равность 0
        data(Addr,Value),Value==0,!,
        %если 0, то удаляем указатель на начало последнего цикла	        
        retract(circle([_|L])),
        %сохраняем хвост
        assert(circle(L)).
goto:-
        %иначе переходим в начало цикла
        circle([[N,_]|_]),
        seeing(Stream),
        seek(Stream,N,bof,_).
% [
loop:-
        %удаляем и получаем указатели на начало цикла
        retract(circle(L)),
        seeing(Stream),
        %определяем позицию в файле
        character_count(Stream,Pos),
        %Получаем значение ячейки
        %(если оно = 0, то не выполняем тело цикла)
        pos(Addr),
        data(Addr,Value),
        assert(circle([[Pos,Value]|L])).

do:-
        %читаем команду
        get_char(X),
        %выполняем ее
        step(X),
        %проверяем на конец файла
        not(at_end_of_stream),!,
        do.
do:-
        %если конец, то закрываем файл
        seeing(Stream),
        close(Stream),
        seen.

        step('['):-loop,!.
        step(']'):-goto,!.
	%это правило предназначено для "проскакивания цикла"
	%(если в него мы зашли с нулевым значением)
        step(_):-circle([[_,StartValue]|_]),StartValue==0,!.
        step('>'):-addr( 1),!.
        step('<'):-addr(-1),!.
        step(','):-cin,!.
        step('.'):-cout,!.
        step('+'):-add( 1),!.
        step('-'):-add(-1),!.
        step(_).

        run(Path):-
        see(Path),
        %удаляем мусор (оставленный после работы предидущей программы)
        retractall(pos(_)),
        retractall(data(_,_)),
        retractall(circle(_)),
        %начинаем с первой ячейки
        assert(pos(1)),
        %с значением 0
        assert(data(1,0)),
        assert(circle([])),do.


Для проверки в терминале пишем:

freest@PC:$ swipl -s <path.tofile>
?-run('Path.to.Brainfuck.code').

Протеструем на примере из Вики.

Hello World! на brainfuck

++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++
.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.
------.--------.>+.>.

Должно выйти что-то вроде этого:

freest@PC:/media/C6984667984655D9$ swipl -s bf.pro
% library(swi_hooks) compiled into pce_swi_hooks 0.00 sec, 2,224 bytes
% /media/C6984667984655D9/bf.pro compiled 0.00 sec, 4,676 bytes
Welcome to SWI-Prolog (Multi-threaded, 32 bits, Version 5.10.4)
Copyright © 1990-2011 University of Amsterdam, VU Amsterdam
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit www.swi-prolog.org for details.

For help, use ?- help(Topic). or ?- apropos(Word).

?- run('a.txt').
Hello World!
true.

?-

Задача 2. Машина Тьюринга


Опять немного теории от Вики
Маши́на Тью́ринга (МТ)— абстрактный исполнитель (абстрактная вычислительная машина). Была предложена Аланом Тьюрингом в 1936 году для формализации понятия алгоритма.
Машина Тьюринга является расширением конечного автомата и, согласно тезису Чёрча— Тьюринга, способна имитировать все другие исполнители (с помощью задания правил перехода), каким-либо образом реализующие процесс пошагового вычисления, в котором каждый шаг вычисления достаточно элементарен.
Конкретная машина Тьюринга задаётся перечислением элементов множества букв алфавита A, множества состояний Q и набором правил, по которым работает машина. Они имеют вид: qiaj→qi1aj1dk (если головка находится в состоянии qi, а в обозреваемой ячейке записана буква aj, то головка переходит в состояние qi1, в ячейку вместо aj записывается aj1, головка делает движение dk, которое имеет три варианта: на ячейку влево (L), на ячейку вправо ®, остаться на месте (N)). Для каждой возможной конфигурации <qi, aj> имеется ровно одно правило. Правил нет только для заключительного состояния, попав в которое машина останавливается. Кроме того, необходимо указать конечное и начальное состояния, начальную конфигурацию на ленте и расположение головки машины.

Будем использовать МТ предложеную Викой

q0*→q0*R
q01→q01R
q0×→q1×R
q11→q2aR
q21→q21L
q2a→q2aL
q2=→q2=L
q2×→q3×L
q31→q4aR
q3a→q3aL
q3*→q6*R
q4×→q4×R
q4a→q4aR
q4=→q4=R
q41→q41R
q4*→q51R
q5*→q2*L
q6a→q61R
q6×→q7×R
q7a→q7aR
q71→q2aR
q7=→q8=L
q8a→q81L
q8×→q9H

data(L,V,R) -представление ленты ( L — левая часть, R — правая, V — текущяя ячейка).
...[1][2][3][4][5][6][7]…
L=[3,2,1] V=4 R=[5,6,7]
Значение пустой ячейки — *

%реверс списка
revers([],R,R):-!.
revers([H|T],L,R):-revers(T,[H|L],R).

%переход в левую ячейку
l:-
%читаем ленту
     (retract(data([Hl|Tl],V,R)),!;
%если левая часть была пустой, то новое положение головки указывает на пустой елемент (*)
     retract(data([],V,R)),Hl=(*),Tl=[]),
%заносим ленту в память
     assert(data(Tl,Hl,[V|R])).
r:-
%читаем ленту
     (retract(data(L,V,[Hr|Tr])),!;
%если правая часть была пустой, то новое положение головки указывает на пустой елемент (*)
     retract(data(L,V,[])),Hr=(*),Tr=[]),
 %заносим ленту в базу   
     assert(data([V|L],Hr,Tr)).
% головка МТ стоит на месте
n.

%Инициализация ленты.
%revers используется для более наглядного представления Ленты(читай описание data).
initData(L,V,R):-
%удаляем старую( если она была)
     retractall(data(_,_,_)),
%переворачиваем левую часть( причина описана выше)
     revers(L,[],Lr),
% заносим ленту в базу.
     assert(data(Lr,V,R)).

%изменение текущей ячейки
input(Value):-
	%Удаляем из базы старую ленту, сохраняя значение Левой и Правой части.
	retract(data(L,_,R)),
	%Заносим ленту с новым значение текущей ячейки.
	assert(data(L,Value,R)).

%Вывод информации о выполнении
info(Q:A:Qn:An:D):-
      %Выводим правило МТ
      write(Q:A),nl,
      write(Qn:An:D),nl,
      %и значение ленты в «человеческом виде»
      data(L,Value,R),revers(L,[],Lr),append(Lr,[[Value]|R],Data),
      write(Data),nl.

%Правила МТ
%Стостояние(ЗначениеЯчейки, НовоеСостояние, Записываемое значение, Движение).
%МТ для умножение чисел в унарной системе исчисления
q0(*,q0,*,r).
q0(1,q0,1,r). 
q0(x,q1,x,r). 
q1(1,q2,a,r). 
q2(1,q2,1,l).
q2(a,q2,a,l).
q2(=,q2,=,l).
q2(x,q3,x,l).
q3(1,q4,a,r).
q3(a,q3,a,l).
q3(*,q6,*,r).
q4(x,q4,x,r).
q4(a,q4,a,r).
q4(=,q4,=,r).
q4(1,q4,1,r).
q4(*,q5,1,r).
q5(*,q2,*,l).
q6(a,q6,1,r).
q6(x,q7,x,r).
q7(a,q7,a,r).
q7(1,q2,a,r).
q7(=,q8,=,l).
q8(a,q8,1,l).
q8(x,e,x,n).

%e — конечное стостояние.
start(e):-write(end),!.
%Действие в стостоянии Q
start(Q):-
	%проверяем значение ячейки
	data(_,A,_),
	%ищем подходяшее правило
	apply(Q,[A,Qn,An,D]),
	%выводим информацию
	info(Q:A:Qn:An:D),
	%записываем значение 
	input(An),
	%двигаем головку
	call(D),
	%переходим в новое стостояние
	start(Qn).


Запускаем МТ

$ swipl -s 1.pro
?- initData([],*,[1,1,1,x,1,1,=,*]).
?- start(q0).

А вот и результат.

$ swipl -s 1.pro

?- initData([],*,[1,1,1,x,1,1,=,*]).
true.

?- start(q0).
q0: (*)
q0: (*):r
[[*],1,1,1,x,1,1,=,*]
q0:1
q0:1:r
[*,[1],1,1,x,1,1,=,*]
….
….
….
q8:a
q8:1:l
[*,1,1,1,x,[a],1,=,1,1,1,1,1,1,*]
q8:x
e:x:n
[*,1,1,1,[x],1,1,=,1,1,1,1,1,1,*]
end
true.

Источники:

  1. Brainfuck
  2. Машина Тьюринга
  3. Prolog
Tags:
Hubs:
+1
Comments 2
Comments Comments 2

Articles