Skip to content

Instantly share code, notes, and snippets.

@MisterTimur

MisterTimur/ATR.PAS

Last active August 29, 2015 14:22
Show Gist options
  • Save MisterTimur/d90f11f1207c323f10c1 to your computer and use it in GitHub Desktop.
Save MisterTimur/d90f11f1207c323f10c1 to your computer and use it in GitHub Desktop.
Download ZIP
programming language ATR
Raw
ATR.PAS
// AbdUlov Timur Rifovich 2015 programming language ATR
// https://sites.google.com/site/timpascallib/atr
program ATR;
uses
sysUtils;
const
Znak='+-*/=(){}|&:<>';// Знаки обрабатываемые знаки
Ti_Ope=10; // Commands Function Оператор
Ti_Cif=20; // Numbers Цифра
Ti_Zna=30; // Знак ОДинарный например = + - / ,
Ti_Kav=40; // "TEXT" В кавычках ""
Ti_Rem=50; // Comentaries Комментарии
LN=Chr(13)+Chr(10); // CR
Type TEl=Class
TIP:Byte; // Тип Элемента Type Element Ti_Ope,Ti_Cif,Ti_Zna Ti_Kav
FUN:Boolean; // Если это Функция if the Function true
NAM:AnsiString; // Наименование элемента
ZNA:AnsiString; // Значение
Rod:Tel; // Родительский элемент Parent Element
Pre:Tel; // предыдущий эллемент Prew element
Nex:Tel; // Следующий элемент Next element
blo:Tel; // Вложеный елемент The Children First E;ements
Procedure Del; // The function does not destroy the item and simply pulls out from the list Функция не разрушает элемент а просто выдергивает из списка
Procedure Cle; // Clear Element Очищает элемент
Function Lst:TEl; // Find Last Element находит последний элемент
Function add(el:Tel):Tel; // add element to end Добавляет едемент в конец списка
Function Add(s:AnsiString;t:Byte):Boolean;// Create and add element to end Создает и добавляет элеемнт
Function Cop(iRod,iPre:Tel):Tel; // Copy Element and child elem Создает копию элемента с дочерними элементами
Procedure ProgRead; // Read programm from Pro Читает программы разбивает на слова
Procedure RunFunc; // Run programm Запускат программу на выполненике
Function FinFunc(n:ansistring):Tel; // Fund word function Ищит Функцию слово
Procedure CompileSc(s1,s2:Ansistring);// puts brackets Вкладывает скобки
Procedure CompileBL(s:Ansistring); //puts parametr func and Block func in element Вкладывает параметры блоки
Procedure TRun; // Run one element запускает на выполнение 1 элемент
Procedure TRunS; // Runs children Elements Выполняет вложеные елементы
Procedure CompileMa(s:ansistring); // matimatic operations Математические операции знаки
Procedure Mat;// + - * / .....
Procedure Sco;// ()
Procedure Pri;// a:=b;
Procedure IFF;// If
Procedure WHI;// While
Procedure Con;// PRINT
Procedure View(s:String); // ПРосмотр внутреней структыр для отладки
Constructor create;
end;
Var
Poi:Longint; // Number read Simvol from TextProgram Указатель на читаемый символ
Len:Longint; // Len Program Длина программы
Pro:Ansistring; // Text Program Текст программы
Co:Ansistring; // Consol Коснсоль
Prog:TEl;
Constructor Tel.create;
begin
Rod:=nil;
Pre:=nil;
Nex:=nil;
blo:=nil;
end;
Function WordC(S:String;C:Char):longint; { Count Word The C Separator Количество слов в строке s с разделитем c }
var
rez,i:Longint;
begin
Rez:=0;
if Length(s)<>0 then
Begin
Rez:=1;
for i:=1 To Length(s) do
if S[i]= C then Inc(Rez);
End;
WordC:=Rez;
end;
Function WordN(s,c:String;N:Longint):Ansistring; { Возвращает слово номер N из строки S с разделителем C }
Var
Rez:String;
Ls,Ns,F:Longint;
begin
// Count Word The C Separator Количество слов в строке s с разделитем c
Rez:= '';
LS:=Length(S);
NS:=1;
F:=1;
while ((F <= LS) and (NS <= N)) do
Begin
if (S[F] = C)
then Inc(NS)
else if (NS = N) then Rez:=Rez+S[F];
Inc(F);
End;
WordN:=Rez;
end;
Function InStr(s,z:String;C:Char):Longint;{ Ищит строку Z в строке S С разделителем C возвращает номер слова в списке если слова нету 0}
var
WC,Rez,Ns:Longint;
begin
// Find String Z in string S Separator C return Number Pos
WC:= WordC(Z,C);
Rez:=0;
NS:=0;
while ((Rez = 0) and (NS <= WC)) do
if (WordN(Z,C,NS)=S) then Rez:= NS else Inc(NS);
InStr:=Rez;
end;
Function EtoCif(s:Ansistring):boolean;
var
f:Longint;
rez:Boolean;
begin
{ checks whether the string number
проверяет является ли строка числом}
rez:=true;
for f:=1 to Length(s) do
if (s[f]<'0') or (s[f]>'9')then begin rez:=false;break end;
EtoCif:=REz;
end;
{ if it does not return an empty string
если это не являеться возвращает пустую строку }
function ReadOpe(s1,s2:Char):Ansistring; // Read Operator Command Читает оператор из строки
var
rez:Ansistring;
begin
{This function reads word Commando from programm string PRO
Эта функция читает оператор слова из строки с программой Pro}
rez:='';
while (Poi<=Len) and ((Pro[Poi]>=s1) and (Pro[Poi]<=s2)) do
begin
rez:=rez+Pro[Poi];
inc(Poi);
end;
Readope:=rez;
end;
Function ReadKav:Ansistring; // "TEXT" Читает строку в кавычках из строки если не удаеться возвращает пустую строку
var
rez:Ansistring;
begin
{This function reads "TEXT" from programm string PRO
Эта функция читает то что содержиться в кавычках в тексте программы }
rez:='';
if (Poi<=Len) and (Pro[Poi]='"') Then
begin
inc(Poi);
while (Poi<=Len)and (Pro[Poi]<>'"') do
begin
rez:=rez+Pro[poi];inc(Poi);
end;
inc(Poi);
end;
ReadKav:=rez;
end;
Function ReadZna(Z:String;c:Char):Ansistring; // Read + - / * ...Читает одинарный знак из строки в случае неудачи возвращает пустую строку
var
rez:Ansistring;
NS,WC,F:Longint;
begin
{ This function reads + - * / { } ( ) from programm string PRO
Эта функция читает знаки из текста программы }
Rez:='';
NS:=1;
WC:=WordC(Z,C);
while ((Rez='') and (NS <= WC)) do
Begin
Rez:=WordN(Z,',',NS);
f:=1;
while (f<=length(rez)) do
if (Rez[f]<>Pro[f+Poi-1]) then Rez:= '' else inc(f);
inc(ns);
End;
Poi:=Poi+Length(Rez);
ReadZna:=Rez;
end;
Function ReadRem:Ansistring; // Read Comments Читает Комментарии
var
rez:Ansistring;
begin
{This function reads Comments from programm string PRO
Эта функция читает комментарии в тексте программы }
rez:='';
if (Poi<=Len-1) and (Pro[poi]='/') and (Pro[Poi+1]='/') Then
begin
Rez:=rez+Pro[Poi];inc(Poi);
while (Poi<=Len-1)and (Pro[Poi]<>chr(13)) do
begin
rez:=rez+Pro[Poi];
inc(Poi);
end;
inc(Poi);
end;
ReadRem:=Rez;
end;
Procedure Tel.Del; // Функция не разрушает элемент а просто выдергивает из списка
var ne,pr:TEl;
begin
ne:=nex;pr:=pre; // Запоминаем предыдущий и следующий элемент
if pre<>nil then pre.nex:=Ne;// Ставим в предыдущем элементе следующий элемент
if nex<>nil then nex.pre:=Pr;// Ставим в следующем элементе предыдущий
if (Rod<>nil) and (Rod.blo=self) then rod.blo:=ne;// Если в родительском элементе мы первые
nex:=nil;
pre:=nil;
rod:=nil;
end;
procedure TEl.Cle; // Очищает элемент
var
l,l2:Tel;
begin
l2:=blo;
while l2<>nil do
begin
l:=l2;
l.Cle;
l2:=l.nex;
l.free;
end;
end;
function Tel.Lst:TEl; // Функция находит последний элемент в списке
var
rez:tel;
begin
rez:=blo; // ОТкрывем первый элемент в списке
if rez<>nil then // Двигаемся в конец списка через цикл
while rez.nex<>nil do rez:=rez.nex;
Lst:=rez; // Возвращаем результат
end;
Function Tel.Add(el:Tel):Tel; // Добавляет едемент в конец списка
begin
// add element to end Добавляет едемент в конец списка
el.del; // Удаляем элемент из предыдущего списка
el.pre:=lst; // ПРисоеденяем к последнему элементу новго списка
if lst<>nil
then begin
el.pre:=lst;
lst.nex:=el;
end // в последнем элементе нового списка указываем следующий элемент
else blo:=el; // если это первый элемент ставим его первым
el.Rod:=Self; // указываем родителя
end;
Function TEl.Add(s:AnsiString;t:Byte):Boolean;// Создает и Добавляет едемент в конец списка
var
rez:Boolean;
E:Tel;
begin // Create and add element to end Создает и добавляет элеемнт
rez:=false;
if s<>'' Then
begin
E:=Tel.create;
E.Fun:=False;
E.Nam:=AnsiUpperCase(s);
E.Zna:=s;
E.Tip:=t;
add(E);
rez:=true;
end;
add:=rez;
end;
Function TEl.Cop(iRod,iPre:Tel):Tel; // Копирует элемент
var
rez:Tel;
pr,ne:Tel;
begin
// Copy Element and child elem Создает копию элемента с дочерними элементами
rez:=Tel.create;// Создаем новый элемент
rez.Nam:=Nam; // И копируем всек значения
rez.Zna:=Zna;
rez.Tip:=Tip;
rez.Fun:=Fun;
rez.Rod:=iRod;
rez.Pre:=iPre; // устанавливаем предыдущий элемент в новом элементе
rez.Nex:=Nil;
rez.Blo:=Nil;
//================================
if blo<>nil then
begin
rez.blo:=blo.cop(rez,nil); // Копируем первый элемент
ne:=blo.nex;// читаем следующий ВЛОЖЕНЫЙ ! элемент
pr:=rez.blo;// Запоминаем предыдущий элемент
while ne<>nil do
begin
pr.nex:=ne.cop(rez,pr);// Копируем Следующий элемент
ne:=ne.nex; // Перемещаемся к следующему элементу
pr:=pr.nex; // назначем предыдущй элемент следующего элемента
end;
end;
Cop:=Rez;
end;
Procedure TEl.ProgRead; // Разбивает строку на слова
begin
// Read programm from Pro Читает программы разбивает на слова
Poi:=1;Len:=Length(pro);
while Poi<=Len do
if ReadRem='' then
if not add(ReadOpe('A','Z'),Ti_Ope) then
if not add(ReadOpe('0','9'),Ti_Cif) then
if not add(ReadKav,Ti_Kav) then
if not add(ReadZna('+,-,*,/,:=,<,>,<=,>=,(,),{,}',','),Ti_Zna) then inc(Poi);
end;
Procedure TEl.CompileSc(s1,s2:Ansistring); // Чтение скобок
var
KON,// контенер Куда вкладываем элементы
UKA,// аказатель элемента с котрым работаем
NE // Следующий элемент
:Tel;
begin
KON:=Self;// Контенер куда вкладываем элементы
UKA:=Blo; // Первый анализируемый элемент
While UKA<>nil do
begin
NE:=UKA.NEX; // запоминаем следующий элемент
if (Self<>KON) and (UKA.Nam<>s2) then KON.add(UKA);// Добавляем в контенер
if UKA.Nam=s1 then KON:=UKA; // Контенер
if UKA.Nam=s2 then begin KON:=KON.ROD;UKA.DEL;end; // Вернуться на уровень вверх
UKA:=NE; // Переходм к следующему элементу
end;
end;
Procedure TEl.CompileBL(s:Ansistring); // Вложение Блоков {} ()
var
UKA:tel;
begin
UKA:=BLO;
while UKA<>nil do
begin
if (UKA.Tip=Ti_Ope) then
if (UKA.nex<>nil) and (UKA.nex.NAm=S) then
begin
if S='{' then UKA.fun:=true;
UKA.add(UKA.nex);
end else uka.add(s,Ti_Zna);
if UKA.BLO<>nil then UKA.CompileBL(s);
UKA:=UKA.NEX;
end;
end;
Procedure TEl.CompileMa(s:ansistring); // Умножение деление
var
l:TEl;
begin
l:=blo;
while l<>nil do
begin
l.CompileMa(s);
if pos(l.NAm[1],s)<>0 then
if (l.pre<>nil) and (l.nex<>nil) then
begin
l.nex.CompileMa(s);
l.add(l.pre);
l.add(l.nex);
end;
l:=l.nex;
end;
end;
Function TEl.FinFunc(n:ansistring):Tel; // Ищит элемент N вверх по иирархии
var
l,REz:Tel;
begin
// Fund word function Ищит Функцию слово
rez:=Nil;
if FUN and (NAM=N) then rez:=self;
// поиск в предыдущих элементах списка
l:=pre;
while (l<>nil) and (rez=nil) do
begin
if (l.Tip=Ti_Ope) and
(l.fun) and
(l.NAm=N) Then rez:=l;
l:=l.pre;
end;
// ПОиск внутри параметрова
if (rez=nil) and
(rod<>nil) and
(rod.fun) and
(rod.blo.nam='(') and
(rod.blo.blo<>nil)
Then
begin
l:=rod.blo.blo;
while (REZ=NIL) AND (l<>nil) do
begin
if l.NAm=n then rez:=l;
l:=l.nex;
end;
end;
// Продолжим поиск функции в родительском элементе
if (rez=nil) and (Rod<>Nil) Then rez:=rod.FinFunc(n);
FinFunc:=rez;
end;
Procedure TEl.RunFunc; // Пытаеться выполнить елемент
var
F,Ru,l1,l2:Tel;
begin
F:=FinFunc(NAm); // Ищим функцию
if f<>nil then
begin
// если такая функция существует
ru:=f.cop(Rod,Pre); // Создаем копию функции
blo.TRun; // Вычисляем параметры
l1:=ru.blo.blo;
l2:=blo.blo;// Копируем параметры
while (l1<>nil) and (l2<>nil) do
begin
l1.Zna:=l2.Zna;
l1:=l1.nex;
l2:=l2.nex;
end;
Ru.blo.nex.TRun;// Выполняем функцию
Zna:=Ru.zna; // Возвращаем значение
Ru.Cle;
Ru.Free;
end;
end;
Procedure TEl.TRunS; // Выполняет список Комманд
var
UKA:TEl;
begin
UKA:=blo;
While UKA<>nil do
begin
if (Not UKA.fun ) or // This Not Function Это не описание функции
(UKA.nam='WHILE') or // This WHILE или это цикл WHILE это не функция но похоже
(UKA.nam='IF' ) // This IF или это условие IF это не функция но похоже
then UKA.TRun;
UKA:=UKA.nex;
end;
end;
Procedure TEl.TRun; // Выполняет 1 команду
begin
if (Nam='*' ) Then MAT else
if (Nam='/' ) Then MAt else
if (Nam='+' ) Then MAt else
if (Nam='-' ) Then MAt else
if (Nam='>' ) Then Mat else
if (Nam='<' ) Then Mat else
if (Nam='&' ) Then Mat else
if (Nam='|' ) Then Mat else
if (Nam='=' ) Then Mat else
//---------------------------------------------------------
if (Nam=':=' ) Then PRI else
if (Nam='PRINT') Then CON else
if (Nam='IF') Then IFF else
if (Nam='WHILE') Then WHI else
if (Nam='(' ) Then SCO else
if (Nam='{' ) Then TRuns else
if (Tip=Ti_Ope ) Then RunFunc;
end;
Procedure TEl.SCO; // Выполняет скобку
var
l:TEl;
rez:Ansistring;
begin
// Выполняет скобку
rez:='';l:=Blo;
while l<>nil do
begin
l.TRun;
rez:=rez+l.zna;
l:=l.nex;
end;
zna:=rez;
end;
Procedure TEl.CON; // Выполняет PRINT
var
l:Tel;
begin
if Blo<>nil then
begin
l:=Blo.Blo;
while l<>nil do
begin
l.TRun;
Co:=Co+l.zna;
L:=l.nex;
end;
Co:=Co+chr(13)+chr(10);
end;
end;
Procedure TEl.Mat; // Выполняет сложение
begin
if (blo<>nil) and (blo.nex<>nil) Then
begin
blo.TRun;
blo.nex.TRun;
if EtoCif(Blo.zna) and EtoCif(Blo.nex.zna)
Then
if nam='+' then zna:=FloatToStr(StrToFloat(Blo.zna)+StrToFloat(Blo.nex.zna)) else
if nam='-' then zna:=FloatToStr(StrToFloat(Blo.zna)-StrToFloat(Blo.nex.zna)) else
if nam='*' then zna:=FloatToStr(StrToFloat(Blo.zna)*StrToFloat(Blo.nex.zna)) else
if nam='/' then zna:=FloatToStr(StrToFloat(Blo.zna)/StrToFloat(Blo.nex.zna)) else
if nam='&' then zna:=FloatToStr(StrToFloat(Blo.zna)*StrToFloat(Blo.nex.zna)) else
if nam='|' then begin if ((StrToFloat(Blo.zna)=1) or (StrToFloat(Blo.nex.zna)=1)) then zna:='1'else zna:='0';end else
if nam='>' then begin if (StrToFloat(Blo.zna)>StrToFloat(Blo.nex.zna)) Then zna:='1'else zna:='0';end else
if nam='<' then begin if (StrToFloat(Blo.zna)<StrToFloat(Blo.nex.zna)) Then zna:='1'else zna:='0';end
else
if nam='+' then zna:=Blo.zna+Blo.nex.zna else
if nam='=' then begin if Blo.zna=Blo.nex.zna then zna:='1' else zna:='0' end else
if nam='>' then begin if Blo.zna>Blo.nex.zna then zna:='1' else zna:='0' end else
if nam='<' then begin if Blo.zna<Blo.nex.zna then zna:='1' else zna:='0' end;
end;
end;
Procedure TEl.PRI; // := Операция присваивания значения
var
F:Tel;
begin
if (blo<>nil) and (blo.nex<>nil) then
begin
Blo.nex.TRun;
F:=FinFunc(Blo.Nam);
if F<>Nil Then F.Zna:=Blo.nex.Zna;
end;
end;
Procedure TEl.IFF; // IF Условиме
var
F:Tel;
begin
if (blo<>nil) and (blo.nex<>nil) then
begin
Blo.nex.TRuns;
if Blo.ZNA='1' then Blo.nex.TRuns;
end;
end;
Procedure TEl.WHI; // While Цикл пока
var
F:Tel;
begin
if (blo<>nil) and (blo.nex<>nil) then
begin
Blo.TRun;
While Blo.zna='1' do
begin
Blo.nex.TRun;
Blo.TRun;
end;
end;
end;
Procedure TEl.View(s:String); // View The Structura for debag ПРосмотр внутреней структыр для отладки
var
l:Tel;
begin
l:=Blo;
While l<>nil do
begin
Writeln(s+l.nam);
if l.blo<>nil then l.View(' '+s);
l:=l.nex;
end;
end;
begin
Prog:=Tel.Create;
Prog.NAM:='PROG';
pro:=AnsiUpperCase(
'//EXAMPLE Object Programming PROGRAM In ATR language '+LN+
// Абстрактная переменная X Abstract X
' Left(a){x:=x-a;} '+LN+
' Obj(a){ '+LN+
' X(){};x:=10; // var x; Обьявленеи переменной '+LN+
' f(){};f:=0; '+LN+
' While (f<3) '+LN+
' { '+LN+
' Left(a); // Call Function Left Вызов функции LEft'+LN+
' f:=f+1; '+LN+
' } '+LN+
' Print(X); '+LN+
' } '+LN+
' Obj(3); ');
Prog.ProgRead;
//Prog.View(''); //For Debug отладки просмотр структуры view structura
Prog.CompileSc('(',')');
Prog.CompileSc('{','}');
Prog.CompileBl('(');
Prog.CompileBl('{');
Prog.CompileMa('*/');
Prog.CompileMa('+-');
Prog.CompileMa('><|&=');
Prog.CompileMa(':=');
Prog.TRunS;
Writeln(Co);
Readln;
end.
@MisterTimur
Copy link
Author

First comment posted Добавил комментарии

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment