Last active
August 29, 2015 14:22
-
-
Save MisterTimur/d90f11f1207c323f10c1 to your computer and use it in GitHub Desktop.
programming language ATR
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
// 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. | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
First comment posted Добавил комментарии