program t; uses dos,crt; const {максимальное количество состояний/символов алфавита} max = 20; {ошибки} er1 = 'Ошибка: файл не найден'; er2 = 'Ошибка: символов входного алфавита слишком много или слишком мало'; er3 = 'Ошибка: состояний слишком мало или слишком много'; er4 = 'Ошибка: в ленте присутствуют символы не соответствующие входному алфавиту'; er5 = 'Ошибка: лента кончилась справа'; er6 = 'Ошибка: лента кончилась слева'; er7 = 'Ошибка: невозможно выполнить сдвиг'; er8 = 'Ошибка: лента пуста'; type {команда} tcom = record move : char; new : integer; out : char; end; {алфавит} talphabet = char; {состояния} tstate = 0..max; var table : array [talphabet,tstate] of tcom; {управляющая таблица} tablefile : text; {файл с управляющей таблицей} k1,k2 : integer; {счётчики} filename : string; {имя файла с управляющй таблицей} curstate : tstate; {текущее состояние} maxalphabet : 0..max; {количество символов входного алфавита} maxstate : tstate; {количество состояний} endstate : tstate; {конечное состояние} tape : string; {лента} curpos : integer; {текущая позиция} curcom : tcom; {текущая команда} symbol : char; {символ входного алфавита} alphabet : array [1..max] of talphabet; {входной алфавит} symbolfind : boolean; {признак соответствия символов на ленте и символов входного алфавита} alphabetend : boolean; {признак конча входного алфавита} begin clrscr; {ввод данных и проверка на их допустимость} write('файл с управляющей таблицей: '); readln(filename); if (fsearch(filename,'') = '') then begin writeln(er1); exit; end; write('количество символов входного алфавита: '); readln(maxalphabet); if (maxalphabet > max) or (maxalphabet <= 0) then begin writeln(er2); exit; end; write('количество состояний: '); readln(maxstate); if (maxstate > max) or (maxstate <= 0) then begin writeln(er3); exit; end; write('лента: '); readln(tape); if (tape = '') then begin writeln(er8); exit; end; {заполнение управляющей таблицы} assign(tablefile,filename); reset(tablefile); alphabetend := false; for k1 := 1 to maxstate do begin writeln('##состояние ',k1); for k2 := 1 to maxalphabet do begin readln(tablefile,symbol); if not alphabetend then alphabet[k2] := symbol; with table[symbol,k1] do begin readln(tablefile,out); readln(tablefile,move); readln(tablefile,new); readln(tablefile); writeln('##',symbol,' -> ',out,' ',move,' ',new); end; end; alphabetend := true; writeln; end; write('##входной алфавит: '); for k1 := 1 to maxalphabet do write(alphabet[k1]); writeln; writeln; {проверка соответсивия символов ленты символам входного алфавита} for k1 := 1 to length(tape) do begin symbolfind := false; for k2 := 1 to maxalphabet do begin if tape[k1] = alphabet[k2] then symbolfind := true; end; if not symbolfind then begin writeln(er4); exit; end; end; {выполнение команды} curstate := 1; endstate := 0; curpos := length(tape); while (curstate <> endstate) do begin curcom := table[tape[curpos],curstate]; writeln('##текущее состояние ',curstate); writeln('##заменяем символ ',tape[curpos],' на ',curcom.out); tape[curpos] := curcom.out; case curcom.move of 'r' : begin if curpos = length(tape) then begin writeln(er5); exit; end else begin inc(curpos); writeln('##сдвигаемся вправо'); end; end; 'n' : begin writeln('##стоим на месте'); end; 'l' : begin if curpos = 1 then begin writeln(er6); exit; end else begin dec(curpos); writeln('##сдвигаемся влево'); end; end; else begin writeln(er7); exit; end; end; curstate := curcom.new; writeln('##переходим в состояние ',curstate); writeln('##текущая лента ',tape); writeln; end; writeln('Результат: ',tape); end.