В общем вот такая вот задача:
>>>На основе стекового арифметико-логического устройства (стекового процессора), используя метод Дейкстры, разработать интерпретатор арифметико-логических выражений, содержащих числа в произвольном формате, квадратные скобки, знаки операций
+ (1) – (1) | * / | ^ | + (2) – (2) | < > = # | ~ | & | !
<------------- ------> -----> ---------> ----------> <----- ------> ----->
и указатели функций exp(<формула>), ln(<формула>).
Сама программа фактически написана, но всё равно какие-то косяки вылезают:
1. Расставление приоритетов не является правильным.
2. В приоритетах не учавствует унарый + и -.
3. При полной проверке (которая на мой взгляд не нужна) происходит недозапись в файл результат.
4. Не считается ln и exp.
5. Не понятное обращение с квадратными скобками.
6. В ОПЗ включаются не все знаки операций.
{Этот модуль нужен для формирования начальной строки с которой нам предстоит работать}
Unit AStream;
Interface
{входной поток значащих символов на основе текстового файла}
Type
PFStreamTxt = ^CFStreamTxt;
CFStreamTxt = Object
public
constructor Create(DataName:String); {создать и открыть поток}
destructor Destroy; virtual; {разрушить поток}
{основные операции}
function GetChar:Char; {текущий значащий символ}
function IsAfterSpace:Boolean; {после символа форматирования?}
procedure Skip;{перейти к следующему значащему символу}
function IsEnd:Boolean; {конец потока?}
{дополнительные и служебные функции}
private
{фиксация/обработка ошибок}
procedure Failure(n:Byte); {завершить аварийно}
{вспомогательные функции}
procedure SkipSpaces; {перейти к следующему значащему символу
или встать в конец потока}
private
{основные поля для одного из вариантов реализации}
DN:String; {имя набора данных}
F:Text;
CharBufer:Char;
AfterSpaceBufer:Boolean;
EndOfStream:Boolean;
{дополнительные и служебные поля}
end;
{другие входные потоки значащих символов}
Implementation
Uses Crt;
{!символы форматирования в кодировке ASCII!}
Const SetOfSpaces:Set of Char=[#9,' ',#255];
{основные операции потока из текстового файла}
constructor CFStreamTxt.Create(DataName:String);
begin
DN:=DataName; EndOfStream:=true;
{$I-} {отключить обработку ошибок ввода-вывода}
Assign(F,DN); Reset(F);
{$I+} {включить обработку ошибок ввода-вывода}
if IOResult <> 0 then
Failure(1)
else
begin
EndOfStream:=false;
SkipSpaces; {пропустить символы форматирования из начала файла}
end;
end;
destructor CFStreamTxt.Destroy; {Убираем мусор после работы програмы}
begin
Close(F); EndOfStream:=true; DN:='';
end;
function CFStreamTxt.GetChar:char;
begin
if EndOfStream then
Failure(2)
else
GetChar:=CharBufer;
end;
function CFStreamTxt.IsAfterSpace:boolean; {свободное место, и еще сразу отрабатываются ошибки}
begin
if EndOfStream then
Failure(3)
else
IsAfterSpace:=AfterSpaceBufer;
end;
unit compil;
interface
uses
crt,astream,mystack;
const
ops: set of char = ['-','+','*','/','^','<','>','=','#','~','&','!','[',']']; {массив знаков которые встречаются в формуле}
digits: set of char = ['0'..'9'];
type
ERRORS=(ERROROFTYPE,
NOTANUMBER_OR_NOTCORRECTIDENTIFIER,
NOT_INITIONALIZED_VARIABLE,
DIVISION_BY_ZERO,
UNKNOWNERROR);
enterpretator=object
procedure error(e:ERRORS); {процедура отвечает за вывод сообщений об ошибках}
function isCorrectNumberOrVariable(t:string):boolean; {проверяет корректность входных параметров}
function getPriority(op:string):integer; {функция отвечает за расстановку приоритетов, т.е. в какой
последовательности они должны выполняться}
function isLeftAssociativity(op:string):boolean; {эта процедура отвечает за проверку ассоциативности, тобищь левая
или правая
причем она будет левой только когда все знаки в уровнении будут расставлены
как положено, в соответствии с заданием}
function typeOp(op:string):integer; {эта функия делает определение типа того как будут выполняться, ведь работа
ведется со стеком}
function getToken(ast: PFStreamTxt):string; {эта шняга проверяет много всего, ну такое как что стоит следующим,
число или ничего,
а еще она перемещает цказатель на нужный элемент}
function IsIt(t:string):integer; {Эта функция работает со стеком знаков}
{ Обработка типа выполняемой опреации и проверка типов операндов}
procedure HandleType(op:string; var st_type,st_value:stack); {}
function compileFormula(ast:PFstreamtxt):string; {функция оформляет файл и содержит в себе все необходимые данные}
function doOperation2(x,y:real;op:string):real; {выполнение группы команд}
function doOperationBool2(x,y:boolean;op:string):boolean; {выполнение логических опраций, таких как or, and}
function doOperation2Bool(x,y:real;op:string):boolean; {выполнение логических операций, типа <,>, = и т.д.}
function doOperation1(x:real;op:string):real; {выполнение унарных операций}
function doOperation1bool(x:boolean;op:string):boolean; {унарная логическая функия}
end;
var g:text; {переменная нужна для создания файла}
implementation
procedure enterpretator.error(e:ERRORS);
begin
case e of
ERROROFTYPE: writeln('Ошибка типа');
NOTANUMBER_OR_NOTCORRECTIDENTIFIER: writeln('Не правильный идентификатор или формат числа');
NOT_INITIONALIZED_VARIABLE: writeln('Переменная не инициализирована');
UNKNOWNERROR: writeln('Неизвестная ошибка');
DIVISION_BY_ZERO: writeln('Деление на ноль');
end;
halt(integer(e));
end;
function enterpretator.isCorrectNumberOrVariable(t:string):boolean;
var r:real; code:integer;
begin
isCorrectNumberOrVariable:=true; {Эта переменная с длинным названием нужна для проверки того что
мы встретили число или знак}
if t[1] in Digits then {Проверка на то, является ли встреченный элемент числом}
begin
val(t, r, Code); {Функция преобразования элемента в нужный тип для работы (из строки в число)}
if code<>0 then isCorrectNumberOrVariable:=false; {Если code не равно 0, значит функция перевода строки
в число не сработала и значит это знак}
end
end;
{
+ (1) - (1)| * / | ^ |+ (2) - (2) | < > = # | ~ | & | !
<----------- ------> --> ---------> ----------> <-- --> ----->
~ ^ * / & ! < > = # een az zi 'salihcumzi eju asv ano ot a ,ugorp ute aladz ib 'toh
}
function enterpretator.getPriority(op:string):integer; {функция расстановки приоритетов, здесь черт ногу сломает, что и куда
и как, но оно вроде правильное!}
begin
getPriority :=-1;
if (op='[') then getPriority := 0 else
if (op=']') then getPriority := 1 else
if (op='!') then getPriority := 2 else
if (op='&') then getPriority := 3 else
if (op='~') then getPriority := 4 else
if (op='#') or (op='=') or (op='>') or (op='<') then getPriority:=5 else
if (op='-') or (op='+') then getPriority:=6 else
if (op='^') then getPriority:=7 else
if (op='/') or (op='*') then getPriority:=8;
if (op='exp') or (op='ln') then getPriority := 9;
end;
function enterpretator.isLeftAssociativity(op:string):boolean;
begin
case op[1] of
'-','+','*','/','^','<','>','=','#','~','&','!': {Эта функция определит где начало счета}
isLeftAssociativity:=false;
else
isLeftAssociativity:=true;
end;
end;
function enterpretator.typeOp(op:string):integer;
begin
typeOp:=-1;
{ R+R=R }
if (op='+') or (op='-') or (op='*') or (op='/') or (op='^') then typeOp:=0 else {переменная нужная для определения перехода,
для правильного вычисления операций}
{ RB>RB=B }
if (op='>') or (op='<') or (op='=') or (op='#') or (op='&') or (op='!') then typeOp:=1 else
{ ~B=B }
if (op='~') then typeOp:=2 else
{ exp(x) }
if (op='+') or (op='-') or (op='exp') or (op='ln') then typeOp:=3;
end;
function enterpretator.getToken(ast: PFStreamTxt):string; {ast это переменная стекового типа, ведь мы работаем со стеком,
она нам нужна для того чтобы мы могли работать со стеком}
var s:string; k:integer; ch:char; {}
begin
s:='';
if (not ast^.IsEnd) then
begin
ch:=ast^.getchar; {ch - это переменная отвечающая за сохранение промежуточного значения числового типа}
if (ch in ops) then {ops - это массив символов описанный выше}
begin
s:=s+ch; {s - это строка в которую мы формируем для работы с несколькими элементами сразу}
if (not ast^.IsEnd) then ast^.skip;
end
else
begin
repeat
if (not ast^.IsEnd) then begin
s:=s+ch;
ast^.skip;
end;
if (not ast^.IsEnd) then ch:=ast^.getchar;
until (ch=' ') or (ch in ops) or (ast^.IsEnd);
end;
end;
getToken:=s;
end;
{
+ (1) - (1)| * / | ^ |+ (2) - (2) | < > = # | ~ | & | !
<----------- ------> --> ---------> ----------> <-- --> ----->
}
function enterpretator.IsIt(t:string): integer; {функция определяет какой из знаком может быть нажат для вычисления}
begin
IsIt:=1;
if (t='[') or (t=']') then isit:=2;
if (t='-') or (t='+') or (t='*') or (t='/') or (t='^') or
(t='&') or (t='!') or (t='>') or (t='<') or (t='=') or
(t='#') or (t='~') or (t='exp') or (t='ln') then IsIt:=0;
end;
function enterpretator.doOperation2(x,y:real;op:string):real; {Следующие несколько функций показываю как и какую
операцию надо выполнять}
begin
case op[1] of
'+': doOperation2:=x+y;
'-': doOperation2:=x-y;
'*': doOperation2:=x*y;
'/': if y<>0 then doOperation2:=x/y else error(DIVISION_BY_ZERO);
{ '!': doOperation2:=x or y;
'&': doOperation2:=x and y; }
'^': doOperation2:=exp(y*ln(x));
end;
end;
function enterpretator.doOperation2Bool(x,y:real;op:string):boolean;
begin
case op[1] of
'>': doOperation2bool:=x>y;
'<': doOperation2bool:=x<y;
'=': doOperation2bool:=x=y;
'#': doOperation2bool:=x<>y;
end;
end;
function enterpretator.doOperationBool2(x,y:boolean;op:string):boolean;
begin
case op[1] of
'!': doOperationBool2:=x or y;
'&': doOperationBool2:=x and y;
end;
end;
function enterpretator.doOperation1(x:real;op:string):real;
begin
case op[1] of
'-': doOperation1:=-x;
'+': doOperation1:=x;
{ '~': doOperation2:=x;}
end;
if op='exp' then doOperation1:=exp(x);
if op='ln' then doOperation1:=ln(x);
end;
function enterpretator.doOperation1bool(x:boolean;op:string):boolean;
begin
case op[1] of
'~': doOperation1bool:=not x;
end;
end;
{ Обработка типа выполняемой опреации и проверка типов операндов}
procedure enterpretator.HandleType(op :string; var st_type,st_value:stack);
var t_type,p_type,t_value,p_value,s: string; x,y,z:real; code:integer; {code - это к какому типу будут приводиться значения}
xb,yb,zb:boolean; {нужны для вывода результата такого как например true или false, которые получаются в результате
выполнения лочических операций}
{x,y,z:real- нужны на самом деле для того же, они используются на выводе и при передаче параметра
в другие функции}
begin
case typeOp(op) of
0:
begin
t_type:=st_type.pop; {stek tipa}
p_type:=st_type.pop; {simvol na vdode}
t_value:=st_value.pop; {rezultat operaciy}
p_value:=st_value.pop; {cislo v vihodnoy potok}
if (t_type[1]<>'R') or (p_type[1]<>'R') then error(ERROROFTYPE);
st_type.push('R');
val(t_value,y,code); if code<>0 then error(NOT_INITIONALIZED_VARIABLE);
val(p_value,x,code); if code<>0 then error(NOT_INITIONALIZED_VARIABLE);
z:=doOperation2(x,y,op);
writeln(g,'Вычисляем: ', x,op,y);
writeln(g,'Результат ',z,' кладем в стек');
str(z,s);
st_value.push(s);
end;
1: {!!!!!!!!!!!!!!!!!!!!!!!}
begin
t_type:=st_type.pop;
p_type:=st_type.pop;
t_value:=st_value.pop;
p_value:=st_value.pop;
if ((t_type<>'R') or (p_type<>'R')) and
((t_type<>'B') or (p_type<>'B')) then error(ERROROFTYPE);
st_type.push('B');
if ((t_type='R') and (p_type='R')) then
begin
val(t_value,y,code); if code<>0 then error(NOT_INITIONALIZED_VARIABLE);
val(p_value,x,code); if code<>0 then error(NOT_INITIONALIZED_VARIABLE);
zb:=doOperation2Bool(x,y,op);
if zb then s:='TRUE' else s:='FALSE';
st_value.push(s);
writeln(g,'Вычисляем: ', x,op,y);
writeln(g,'Результат ',zb,' кладем встек');
end
else
begin
yb:=(t_value='TRUE');
xb:=(p_value='TRUE');
if ((t_value<>'TRUE') and (t_value<>'FALSE')) then error(NOT_INITIONALIZED_VARIABLE);
if ((p_value<>'TRUE') and (p_value<>'FALSE')) then error(NOT_INITIONALIZED_VARIABLE);
zb:=doOperationBool2(xb,yb,op);
if zb then s:='TRUE' else s:='FALSE';
st_value.push(s);
writeln(g,'Вычисляем: ', xb,op,yb);
writeln(g,'Результат ',zb,' кладем встек');
end
end;
2:
begin
t_type:=st_type.pop;
t_value:=st_value.pop;
if (t_type<>'B') then error(ERROROFTYPE);
st_type.push('B');
if ((t_value<>'TRUE') and (t_value<>'FALSE')) then error(NOT_INITIONALIZED_VARIABLE);
xb:=(t_value='TRUE');
zb:=doOperation1Bool(xb,op);
if zb then s:='TRUE' else s:='FALSE';
st_value.push(s);
writeln(g,'Вычисляем: ', op,xb);
writeln(g,'Результат ',zb,' кладем в стек');
end;
3:
begin
t_type:=st_type.pop;
t_value:=st_value.pop;
if (t_type<>'R') then error(ERROROFTYPE);
st_type.push('R');
val(t_value,x,code); if code<>0 then error(NOT_INITIONALIZED_VARIABLE);
z:=doOperation1(x,op);
str(z,s);
st_value.push(s);
writeln(g,'Вычисляем: ', op,'(',x,')');
writeln(g,'Результат ',z,' кладем в стек');
end
end;
end;
function enterpretator.compileFormula(ast:PFstreamtxt):string;
var
inpstr: string;
outstr: string;
st: Stack; {-- Стек операций --}
st_type: Stack; {-- Стек типов --}
st_value:Stack; {-- Стек значений --}
t,p,s: string;
i,code:integer;
r:real;
begin
writeln(g,'Протокол дейсвтий:');
writeln('Протокол дейсвтий смотри в файле результатов');
outstr:='';
st.init;
st_type.init;
st_value.init;
{ ch:=ast^.getchar;}
t:=getToken(ast);
while length(t)>0 do
begin
case IsIt(t) of
0: { Операция }
begin
p:=st.viewtop;
if p='(' then st.push(t)
else
begin
p:=st.viewtop;
if (getPriority(p)<getPriority(t))or
((getPriority(p)= getPriority(t))and(not isLeftAssociativity(t)))
then
begin
st.push(t);
end
else
begin
while ((getPriority(p)>getPriority(t))or
((getPriority(p)=getPriority(t))and
(isLeftAssociativity(t)))) do
begin
p:=st.pop;
HandleType(p,st_type,st_value);
{--------------}
outstr:=outstr+p+' ';
p:=st.viewtop;
end;
st.push(t);
end;
end;
end;
1: { Число или Переменная }
begin
if isCorrectNumberOrVariable(t) then
begin
outstr:=outstr+t+' ';
st_type.push('R');
st_value.push(t);
end
else
Error(NOTANUMBER_OR_NOTCORRECTIDENTIFIER);
end;
2: { Скобка }
begin
if t='(' then st.push(t)
else
begin
p:=st.pop;
while (p<>'(') do
begin
HandleType(p,st_type,st_value);
outstr:=outstr+p+' ';
p:=st.pop;
end
end;
end;
end;
Writeln(g,'Получаем очередную лексему для разбора. Это -- ',t);
t:=getToken(ast);
writeln(g,'------- Состояния стеков --------');
writeln(g,'Cтек операций:');
st.printfile(g);
writeln(g);
writeln(g,'Cтек типов:');
st_type.printfile(g);
writeln(g);
writeln(g,'Cтек значений:');
st_value.printfile(g);
writeln(g);
end;
p:=st_type.pop;
s:=st_value.pop;
{ if (not st_type.isEmpty) or (not st.isEmpty) then Error(UNKNOWNERROR); zakomentirovat'}
writeln('Тип результата: ', p);
writeln(g,'Тип результата: ', p);
if p='R' then
begin
val(s,r,code);
writeln('Результат: ', r:14:9);
writeln(g,'Результат: ', r:14:9);
end
else
begin
writeln('Результат: ', s);
writeln(g,'Результат: ', s);
end;
compileFormula:=outstr;
end;
end.
{$A+,B-,D+,E+,F-,G-,I+,L+,N-,O-,P+,Q-,R-,S+,T-,V+,X+}
{$M 16384,0,655360}
unit myStack;
interface
type
pelement=^element;
element=record
data: string;
next: pelement;
end;
Stack=object
top: pelement;
constructor init;
function isEmpty: boolean;
function pop: string;
procedure print;
procedure printfile(var g:text);
procedure push(a: string);
function viewtop: string;
end;
implementation
constructor Stack.init; {- фєьр¦ Tv фюурфрышё№ ¤Єю шэшЎшрышчрЎш ёЄхър}
begin
top:=nil;
end;
function Stack.isEmpty:boolean; {ёЄхъ ўшёЄ ъръ ьырфхэхЎ}
begin
isEmpty:=(top=nil);
end;
function Stack.pop: string; {ЇєэъЎш тvЄрыъштрэш шч ёЄхър}
var temp:pelement; s:string;
begin
if not Stack.IsEmpty then
begin
s :=top^.data;
temp :=top;
top :=top^.next;
if (temp <> nil) then
dispose(temp);
pop :=s;
end;
end;
function Stack.viewtop: string; {ЇєэъЎш юяЁхфхыхэш ёыхфє¦•хую ¤ыхьхэЄр}
begin
viewtop:=top^.data;
end;
procedure Stack.print;
var temp:pelement;
begin
temp:=top;
while (top<>nil) do
begin
write(top^.data,' ');
top:=top^.next;
end;
top:=temp;
end;
procedure Stack.printfile(var g:text);
var temp:pelement;
begin
temp:=top;
while (top<>nil) do
begin
write(g,top^.data,' ');
top:=top^.next;
end;
top:=temp;
end;
procedure Stack.push(a:string); {яЁюЎхфєЁр фюсртыхэш т ёЄхъ чэрўхэшщ}
var temp:pelement;
begin
new(temp);
temp^.data:=a;
temp^.next:=top;
top:=temp;
end;
end.
{Стандартный интерфейс для пользователя}
uses
crt,astream,mystack,compil;
var
ast: PFStreamTxt;
fname,gname:string;
ch:char;
c:enterpretator;
outstr:string;
begin
clrscr;
writeln('Введите имя входного файла: ');
readln(fname);
writeln('Введите имя файла результата: ');
readln(gname);
assign(g,gname);
rewrite(g);
new(ast,create(fname));
writeln('Формула на входе: ');
writeln(g,'Формула на входе: ');
while(not ast^.isEnd)do
begin
write(ast^.getChar);
write(g,ast^.getChar);
ast^.skip;
end;
writeln; writeln(g);
dispose(ast,destroy);
new(ast,create(fname));
outstr:=c.compileFormula(ast);
writeln('ОПЗ с учетом ассоциативности и приоритетов:');
writeln(g,'ОПЗ с учетом ассоциативности и приоритетов:');
writeln(outstr);
writeln(g,outstr);
dispose(ast,destroy);
close(g);
readkey;
end.
