Курсовые по программированию / 20_var_kurs / KURSOV

{define debug}
{$M $4000,0,0}

uses crt;

Type
kwType=(kwNothing, kwOpSk, kwClSk, kwMain, kwDo, kwWhile, kwPrintf, kwDefine, kwUnion, kwInclude, kwFloat);

const
os='{Error:';
KWarray:array [kwOpSk..kwFloat] of string
=('{','}','main','do','while','printf','#define','union','#include','float');
MaxStr=100;
azbuki=['a'..'z','A'..'Z','_'];
oo=['<','>','=','!'];
signs=['+','-','/','*'];
zif=['0'..'9'];
var_symb:set of #0..#255=['a'..'z','A'..'Z','_','-','0'..'9'];

var
text1, text2:array [1..MaxStr] of string {ўе Ё ўле ¬ ббЁўл};
kstr, kstr2{Є®«-ў® бва®Є ўе Ё ўле},
Nstr,Npos {Ї®§ЁжЁп ў® ўе ¬ ббЁўҐ},
Nstr2{’ҐЄ Ї®§ ў ўле ¬ б},
kerr{Є-ў® ®иЁЎ®Є}:integer;
Fname1,Fname2:string; {Ё¬Ґ­  д ©«®ў б Їгвп¬Ё}
f1,f2:text; {д ©«®ўлҐ ЇҐаҐ¬Ґ­­лҐ}
TypeComment:integer; {// - 1, /* ... */ - 2}
Ae:string[80]; {бва®Є  ¤«п ae Ё le}
Pf:integer; {Ї®§ЁжЁп ¤«п ae Ё le}
Flag,def,v_open,mainflg,InclFlg,print,un:boolean; {ўбпЄЁҐ д« ЈЁ}
ostr:string; {ўл室­ п бва®Є  ¤«п le}
qwe,l:integer; {ҐйҐ Ї®§ЁжЁп ¤«п le Ё ¤«Ё­  бва®ЄЁ}
fl:boolean; {д« Ј ¤«п le}
perem:array [1..20] of string; {¬ ббЁў ЇҐаҐ¬Ґ­­ле}
KolPer:integer; {Є®«-ў® ЇҐаҐ¬Ґ­­ле}
i:integer; {бзҐвзЁЄ ¤«п жЁЄ«®ў}
NUnStr:integer; {бва®Є , ў Є®в®а®© ­ зЁ­ Ґвбп union}
nfl:char; {­®¬Ґа ЇҐаҐ¬Ґ­­®© ў union}
procedure CopyN(n:integer); Forward;
procedure OutStr(s:string); Forward;
procedure SkipSp; Forward;
procedure ferror(err:integer); Forward;
function IsComment:boolean; Forward;
function Fae:boolean;forward;

{=======================================================}
{=================== AE ===============}
{=======================================================}

{=======Їа®ЇгбЄ Їгбвле бЁ¬ў®«®ў============================}
procedure space(ert:string);
begin
while(ert[qwe]=' ')and(qwe<=length(ert))and(ert[qwe]<>';') do
inc(qwe);
end;

{=========== дг­ЄжЁп Їа®ўҐаЄЁ §­ Є  ================}
function Znak:Boolean;
begin
Znak:=ae[pf]in ['+','-'];
end;
{======== дг­ЄжЁп Їа®ўҐаЄЁ жЁдал============}
function IsDigit(ch:Char):Boolean;
begin
IsDigit:=Ch in ['0'..'9'];
end;
{=============дг­ЄжЁп Їа®ўҐаЄЁ « вЁ­бЄ®© ЎгЄўл=============}
function IsAlpha(ch:char):Boolean;
begin
IsAlpha:=Ch in ['A'..'Z','a'..'z'];
end;

{===========Їа®ўҐаЄ  Є®­бв ­вл========================}
function Fconst:Boolean;
begin
Flag:=True;
while (pf<=Length(ae))and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
Flag:=False;
end;
if ae[pf]='.' then
begin
ostr:=ostr+ae[pf];
inc(pf);
while(pf<=length(ae)) and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
Flag:=False;
end;
end;
if Flag then
begin
Fconst:=True;
exit;
end;
if ae[pf]='E' then
begin
ostr:=ostr+ae[pf];
Inc(pf);
if Znak then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
if not(IsDigit(ae[pf])) then
begin
Fconst:=True;
Exit;
end;
while (pf<=Length(ae)) and IsDigit(ae[pf]) do
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
end;
Fconst:=False;
end;
{=============== Їа®ўҐаЄ  Ё¤Ґ­вЁдЁЄ в®а  =================}
function Fid:Boolean;
begin
if (pf<=Length(ae)) and not IsAlpha(ae[pf]) then
begin
Fid:=True;
Exit;
end;
while (pf<=Length(ae)) and (IsAlpha(ae[pf]) or IsDigit(ae[pf])) do
begin
ostr:=ostr+ae[pf];
inc(pf);
end;
Fid:=False;
end;
{========== Їа®ўҐаЄ  ЇҐаҐ¬Ґ­­®© ===============}
function Fper:Boolean;
begin
if Fid then
begin
Fper:=True;
Exit;
end;
if ae[pf]='[' then
begin
repeat
ostr:=ostr+ae[pf];
inc(pf);
if Fae then
begin
Fper:=True;
Exit;
end;
until (ae[pf]<>',');
if ae[pf] <>']' then
begin
Fper:=True;
Exit;
end;
ostr:=ostr+ae[pf];
Inc(pf);
end;
Fper:=False;
end;
{============== Їа®ўҐаЄ  ¬­®¦ЁвҐ«п =======================}
function Fmnog:Boolean;
begin
if ae[pf]='(' then
begin
ostr:=ostr+ae[pf];
Inc(pf);
if Fae then
begin
Fmnog:=True;
Exit;
end;
if ae[pf]=')' then
begin
ostr:=ostr+ae[pf];
inc(pf);
end
else
begin
Fmnog:=true;
exit;
end;
end
else
if Fper and Fconst then
begin
Fmnog:=True;
Exit;
end;
Fmnog:=False;
end;
{=========== Їа®ўҐаЄ  б« Ј Ґ¬®Ј® ====================}
function Fslag:boolean;
begin
while True do
if Fmnog then
begin
Fslag:=True;
Exit;
end
else
if (ae[pf]='*')or (ae[pf]='/') then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end
else
begin
Fslag:=False;
Exit;
end;
end;
{========= ae ====================}
function Fae:boolean;
begin
if Znak then
begin
ostr:=ostr+ae[pf];
Inc(pf);
end;
while True do
begin
qwe:=pf;
space(ae);
pf:=qwe;
if Fslag then
begin
Fae:=True;
Exit;
end;
if Znak then
begin
ostr:=ostr+ae[pf];
inc(pf);
end
else
begin
Fae:=False;
Exit;
end;
end;
end;

procedure go;
begin
if (pf<=l) then
begin
ostr:=ostr+ae[pf];
inc(pf);
end;
end;


function le2:boolean; forward;
{============ ®Ўа Ў®вЄ  ! ============}
function nots:boolean;
begin
if (ae[pf]='!')and(ae[pf+1]<>'=') then
begin
nots:=true;
ostr:=ostr+'not';
inc(pf);
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
nots:=false;
exit;
end;
end;
{============= ®Ўа Ў®вЄ  || ===========================}
function ors:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if ((ae[pf]='|')and(ae[pf+1]='|')) then
begin
pf:=pf+2;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf]='(')or(ae[pf]in azbuki)or(ae[pf]='!') then
begin
ostr:=ostr+' or ';
ors:=true;
fl:=false;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
ostr:=os+'­Ґв 1 ®ЇҐа ­¤  ¤«п || : "'+ae+'"}';
ors:=false;
exit;
end;
end
else
ors:=false;
end;
{=========== ®Ўа Ў®вЄ  && ================}
function ands:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if ((ae[pf]='&') and (ae[pf+1]='&')) then
begin
inc(pf,2);
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf]='(')or(ae[pf]in azbuki)or(ae[pf]='!') then
begin
ostr:=ostr+' and ';
ands:=true;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
else
begin
ostr:=os+'­Ґв 1 ®ЇҐа ­¤  ¤«п && : "'+ae+'"}';
ands:=false;
exit;
end;
end
else
ands:=false;
end;

{========== Їа®ўҐаЄ  §­ Є  ба ў­Ґ­Ёп ====================}
function ooo:boolean;
begin
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
if (ae[pf] in oo) then
begin
ooo:=false;
if (ae[pf]='=') and (ae[pf+1]='=') then
begin
ostr:=ostr+'=';
inc(pf,2);
end
else
if ae[pf+1] in oo then
begin
if (ae[pf]='!')and(ae[pf+1]='=')then
begin ostr:=ostr+'<>'; inc(pf,2); end
else
begin
ostr:=ostr+ae[pf]+ae[pf+1];
inc(pf,2);
end
end
else
begin
go;
qwe:=pf;
while(ae[qwe]=' ')and(qwe<=length(ae))and(ae[qwe]<>';') do inc(qwe);
pf:=qwe;
exit;
end
end
else
ooo:=true;
end;

{=============== дг­ЄжЁп Їа®ўҐаЄЁ:§­ Є «Ё ⥪гйЁ© бЁ¬ў®« ========}
function sign:boolean;
begin
if (pf<=l) then
begin
if (ae[pf] in signs) then sign:=true
else sign:=false;
end;
end;

{=========== Їа®ўҐаЄ  б« Ј Ґ¬®Ј® ===========================}
function slag1:boolean;
begin
if ae[pf]='(' then
begin
go;
if fl then fl:=false;
while (ae[pf]<>')')and(pos(os,ostr)=0)do
begin
if (not le2) and (pf<l)then
begin
slag1:=false;
if (pos(os,ostr)=0) and (ae[pf]<>')')or (pf=l) then
begin write(ae[pf],pf);
ostr:=os+'­Ґв ")" : "'+ae+'"}';
exit;
end
else if ae[pf]=')' then
begin
slag1:=true;
go;
exit;
end;
end
else
if pf=l then exit;
end;
end
else
begin
slag1:=false;
exit;
end;
end;

{============== дг­ЄжЁп Їа®ўҐаЄЁ:жЁда  «Ё ⥪гйЁ© бЁ¬ў®« ============}
function consta:boolean;
begin
if (pf<=l) then
begin
if (ae[pf]in zif)and not(ae[pf+1]in azbuki) then
begin
consta:=true;
go;
end
else if (ae[pf]in zif) then
begin
consta:=false;
ostr:=os+'Ё¤Ґ­вЁдЁЄ в®а ­ зЁ­ Ґвбп б жЁдал:: "'+ae+'"}';
exit;
end;
end;
end;

{==========================================}
function es1:boolean;
begin
if (not ors and (pos(os,ostr)=0))and
(not ands and (pos(os,ostr)=0))and
(not nots and (pos(os,ostr)=0))then
begin
es1:=false;
exit;
end
else
es1:=true;
end;

{================= Їа®ўҐаЄ  ­  ЎгЄўг ===================}
function alpha:boolean;
begin
if (pf<=l) then
begin
if (ae[pf] in azbuki) then alpha:=true
else alpha:=false;
end;
end;

{========== le ====================}
function le2:boolean;
begin
l:=length(ae);
while (pos(os,ostr)=0) and(pf<=l)and (ae[pf]<>';')do{Ї®Є  ­Ґ ®иЁЎЄ  Ё ­Ґ `;`}
begin
if (slag1 or es1)and (pos(os,ostr)=0)then le2:=true
else if not(consta or sign) then go
else if not(ooo) then le2:=true
else
if Fae then
begin
le2:=false; {в® ®иЁЎЄ  Ё ўл室 Ё§ дг­ЄжЁЁ}
exit;
end
else
le2:=true;
end;
end;

{======= Їа®ўҐаЄ  "(" ===== TRUE - OK ============}
function IsOSk:boolean;
begin
if text1[nstr,npos]='(' then
IsoSk:=true
else
IsoSk:=false;
end;
{======= Їа®ўҐаЄ  ")" ===== TRUE - OK ============}
function IsCSk:boolean;
begin
if text1[nstr,npos]=')' then
IscSk:=true
else
IscSk:=false;
end;
{======= Їа®ўҐаЄ  ";" ===== TRUE - OK ============}
function IsTz:boolean;
begin
if text1[nstr,npos]=';' then
Istz:=true
else
Istz:=false;
end;

{=========== ЋЎа Ў®вЄ  ®вЄа дЁЈ бЄ ===============}
Procedure fOpSk;
begin
if un then exit;
inc(nstr2);
inc(kstr2);
OutStr('Begin');
npos:=npos+1;
SkipSp;
if npos<=length(text1[nstr]) then
ferror(1);

end;

{=========== ЋЎа Ў®вЄ  § Єа дЁЈ бЄ ============}
Procedure fClSk;
begin
if un then exit;
inc(nstr2);
inc(kstr2);
OutStr('End');
npos:=npos+1;
if nstr=kstr then
OutStr('.')
else
OutStr(';');
SkipSp;
if npos<=length(text1[nstr]) then
ferror(1);
end;

{====================== ЋЎа Ў®вЄ  ЇаЁбў Ёў ­Ёп ============}
function fPrisv:boolean;
var i,kol_prisv,kol_tz:integer;

begin
if pos('=',text1[nstr])>0 then
begin
fPrisv:=true;
inc(nstr2);
inc(kstr2);
i:=npos; kol_prisv:=0; kol_tz:=0;
while i<=length(text1[nstr]) do
begin
if text1[nstr,i]='=' then inc(kol_prisv);
if text1[nstr,i]=';' then inc(kol_tz);
inc(i);
end;
if (kol_prisv>1)or(kol_tz<>1) then begin
ferror(13);
exit;
end;
ae:=copy(text1[nstr],npos,pos('=',text1[nstr])-npos);
pf:=1;
if fper or (pf<=length(ae)) then
begin
ferror(13);
exit;
end;
copyn(pos('=',text1[nstr])-npos);
SkipSp;
inc(npos);
SkipSp;
ae:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
pf:=1;
if fae or (pf<=length(ae)) then
begin
ferror(13);
exit;
end;
OutStr(':=');
copyn(pos(';',text1[nstr])-npos);
outstr(';');
inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
end
else
begin
fPrisv:=false;
exit;
end;
end;


{=========== ЋЎа Ў®вЄ  "main" ===============}
Procedure fMain;
begin
mainflg:=true;
npos:=npos+4;
SkipSp;
if IsOSk then
npos:=npos+1
else
begin
inc(nstr2);
inc(kstr2);
fError(5);
exit;
end;
SkipSp;
if IsCSk then
npos:=npos+1
else
begin
inc(nstr2);
inc(kstr2);
fError(5);
exit;
end;
skipsp;
if npos<=length(text1[nstr]) then
begin
inc(nstr2);
inc(kstr2);
ferror(1);
end;
end;

{=========== ЋЎа Ў®вЄ  "do" ===============}
Procedure fDo;
begin
inc(nstr2);
inc(kstr2);
Outstr('repeat');
npos:=npos+2;
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
end;

{=========== ЋЎа Ў®вЄ  "while" ===============}
Procedure fWhile;
begin
inc(nstr2);
inc(kstr2);
npos:=npos+5;
skipsp;
if IsOSk then inc(npos) else
begin
ferror(7);
exit;
end;
SkipSp;
ae:=text1[nstr]; pf:=npos;
ostr:='';
if le2 then;
npos:=pf;
SkipSp;
if IsCSk then inc(npos) else
begin
ferror(7);
exit;
end;
SkipSp;
if not IsTz then
begin
ferror(7);
exit;
end;
OutStr('until not('+ostr+');');
inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);

end;


{=========== ЋЎа Ў®вЄ  "printf" ===============}
Procedure fPrintf;
var
np:integer;
begin
ostr:='';
inc(nstr2);
inc(kstr2);
if not InclFlg then
begin
inc(kerr);
OutStr('{Error: Function "printf" should have a prototype}');
exit;
end;
inc(npos,6);
skipsp;

if IsOSk then inc(npos) else
begin
ferror(8);
exit;
end;
skipsp;
if text1[nstr,npos]='"' then inc(npos) else
begin
ferror(8);
exit;
end;
while (text1[nstr,npos]<>'"') and
(npos<=length(text1[nstr])) do inc(npos);
if npos>length(text1[nstr]) then
begin
ferror(8);
exit;
end else inc(npos,2);
np:=npos;
repeat
skipsp;
while text1[nstr,npos] in var_symb do inc(npos);
skipsp;
if (text1[nstr,npos]=',') and (text1[nstr,npos+1]<>')') then inc (npos);
until IsCSk or (npos>length(text1[nstr]));
if (npos>length(text1[nstr]))or not(iscsk) then
begin
ferror(8);
exit;
end;
inc(npos);
skipsp;
if not istz then
begin
ferror(8);
exit;
end else inc(npos);
skipsp;
if npos<=length(text1[nstr]) then
ferror(1);
{========= ®Ўа Ў®вЄ  ==============}
npos:=pos('"',text1[nstr])+1;
print:=false;
while text1[nstr,npos]<>'"' do
begin
if pos('%f',copy(text1[nstr],npos,length(text1[nstr])-npos+1)) = 1 then
begin
if print then
begin
print:=false;
outstr(chr(39)+'); ');
end;
inc(npos,2);
ostr:='write(';
while (text1[nstr,np]<>',')
and(text1[nstr,np]<>')')
and (np<=length(text1[nstr]))
and (text1[nstr,np]<>';') do
begin
ostr:=ostr+text1[nstr,np];
inc(np);
end;
if length(ostr)=length('write(') then
begin
ferror(8);
exit;
end
else
ostr:=ostr+'); ';
inc(np);
end else
if pos('\n',copy(text1[nstr],npos,length(text1[nstr])-npos+1)) = 1 then
begin
if print then
begin
print:=false;
outstr(chr(39)+'); ');
end;
ostr:='writeln; ';
inc(npos,2);
end
else
begin
if not print then
begin
ostr:='write('+chr(39)+text1[nstr,npos];
inc(npos);
print:=true;
end else
begin
ostr:=text1[nstr,npos];
inc(npos);
end;
end;
Outstr(ostr);
end;
if text1[nstr,np] in var_symb then ferror(8);
end;

{=========== ЋЎа Ў®вЄ  "#define" ===============}
Procedure fDefine;
begin
inc(nstr2);
inc(kstr2);
if not def then
begin
outstr('const');
inc(nstr2);
inc(kstr2);
end;
npos:=npos+7;
skipsp;
while text1[nstr,npos]<>' ' do copyn(1);
outstr(' = '+chr(39));
skipsp;
copyn(length(text1[nstr])-npos+1);
outstr(chr(39)+';');
def:=true;
end;

{=========== ЋЎа Ў®вЄ  "union" ===============}
Procedure fUnion;
begin
un:=true;
inc(nstr2);
inc(kstr2);
if not v_open then
begin
outstr('var');
inc(nstr2);
inc(kstr2);
v_open:=true;
end;
NUnStr:=nstr2;
inc(nstr2);
inc(kstr2);
end;

{=========== ЋЎа Ў®вЄ  "#include" ===============}
Procedure fInclude;
begin
npos:=npos+8;
SkipSp;
if text1[nstr,npos]='<' then inc(npos) else begin
ferror(11);
exit;
end;
if (pos('>',text1[nstr])>0)
and (pos('>',text1[nstr])-pos('<',text1[nstr])<=12) then
npos:=pos('>',text1[nstr])+1 else begin
ferror(11);
exit;
end;
SkipSp;
if npos<=length(text1[nstr]) then begin
ferror(11);
exit;
end;
if pos('stdio.h',text1[nstr])>0 then InclFlg:=true;
end;

{=========== ЋЎа Ў®вЄ  "float" ===============}
Procedure fFloat;
var i,j:integer;
er:boolean;
str:string;
begin
er:=true;
inc(nstr2);
inc(kstr2);
if un then begin
outstr(nfl+':(');
inc(nfl);
end;
if not v_open then
begin
outstr('var');
inc(nstr2);
inc(kstr2);
end;
npos:=npos+5;
skipsp;
i:=npos;
while (npos<=length(text1[nstr])) and (text1[nstr,npos] in var_symb) do inc(npos);
skipsp;
if IsTz then
begin
npos:=i;
str:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
j:=1;
while (j<=kolper)and(perem[j]<>str) do inc(j);
if j>KolPer then
begin
KolPer:=KolPer+1;
Perem[KolPer]:=Str;
copyn(pos(';',text1[nstr])-npos);
if not un then
Outstr(':real;')
else
Outstr(':real);');
er:=false;
end
end
else
if text1[nstr,npos]='[' then
begin
inc(npos);
skipsp;
while IsDigit(text1[nstr,npos]) do inc(npos);
skipsp;
if text1[nstr,npos]=']' then
begin
inc(npos);
if text1[nstr,npos]=';' then
begin
npos:=i;
str:='';
while (text1[nstr,npos] in var_symb) do
begin
str:=str+text1[nstr,npos];
inc(npos);
end;
j:=1;
while (j<=kolper)and(perem[j]<>str) do inc(j);
if j>KolPer then
begin
KolPer:=KolPer+1;
Perem[KolPer]:=Str;
npos:=pos('[',text1[nstr])+1;
OutStr(str);
outstr(':array [1..');
copyn(pos(']',text1[nstr])-npos);
if not un then
outstr('] of real;')
else
Outstr('] of real);');
if pos(']',text1[nstr])-pos('[',text1[nstr])<>1 then er:=false;
end;
end;
end;
end;
if er then ferror(12);
v_open:=true;
end;


{=========== Їа®ўҐаЄ  Є-ў  ®вЄалў ойЁебп Ё § Єалў ойЁебп бЄ®Ў®Є
============= TRUE - ®иЁЎЄ  ====================================}
function CheckSk:boolean;
var i,j, nopen, nclose:integer;
begin
nopen:=0; nclose:=0;
for nstr:=1 to kstr do
for j:=1 to length(text1[nstr]) do
if text1[nstr,j]='{' then
nopen:=nopen+1
else
if text1[nstr,j]='}' then
nclose:=nclose+1;
if nopen=nclose then
CheckSk:=false
else
CheckSk:=true;
nstr:=1;
end;

{===============================================================}
{===================== а бЇ®§­ ў ­ЁҐ Є«о祢®Ј® б«®ў  ===========}
{===============================================================}
function kw:kwType;
begin
kw:=kwNothing;
if (pos(kwArray[kwOpSk], text1[nstr])=npos) then
kw:=kwOpSk
else
if (pos(kwArray[kwClSk], text1[nstr])=npos) then
kw:=kwClSk
else
if (pos(kwArray[kwMain], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwMain])]=' ')
or
(text1[nstr,npos+length(kwArray[kwMain])]='(')
or
(text1[nstr,npos+length(kwArray[kwMain])]=chr(0)) then
kw:=kWMain;
end
else
if (pos(kwArray[kwDo], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwDo])]=' ') or
(text1[nstr,npos+length(kwArray[kwDo])]=chr(0)) then
kw:=kWDo;
end
else
if (pos(kwArray[kwWhile], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwWhile])]=' ')
or
(text1[nstr,npos+length(kwArray[kwWhile])]='(')
or
(text1[nstr,npos+length(kwArray[kwWhile])]=chr(0)) then
kw:=kWWhile;
end
else
if (pos(kwArray[kwprintf], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwprintf])]=' ')
or
(text1[nstr,npos+length(kwArray[kwprintf])]='(')
or
(text1[nstr,npos+length(kwArray[kwprintf])]=chr(0)) then
kw:=kWprintf;
end
else
if (pos(kwArray[kwdefine], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwdefine])]=' ')
or
(text1[nstr,npos+length(kwArray[kwdefine])]='(')
or
(text1[nstr,npos+length(kwArray[kwdefine])]=chr(0)) then
kw:=kWdefine;
end
else
if (pos(kwArray[kwUnion], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwUnion])]=' ')
or
(text1[nstr,npos+length(kwArray[kwUnion])]='(')
or
(text1[nstr,npos+length(kwArray[kwUnion])]=chr(0)) then
kw:=kWUnion;
end
else
if (pos(kwArray[kwInclude], text1[nstr])=npos)
then
begin
if (text1[nstr,npos+length(kwArray[kwInclude])]=' ')
or
(text1[nstr,npos+length(kwArray[kwInclude])]='(')
or
(text1[nstr,npos+length(kwArray[kwInclude])]=chr(0)) then
kw:=kWInclude;
end
else
if (pos(kwArray[kwFloat], text1[nstr])=npos)
then
if (text1[nstr,npos+length(kwArray[kwFloat])]=' ')
or
(text1[nstr,npos+length(kwArray[kwFloat])]='(')
or
(text1[nstr,npos+length(kwArray[kwFloat])]=chr(0)) then
kw:=kWFloat;
end;


{====================== Їа®ўҐаЄ  ­ з «  Є®¬Ґ­в аЁп ==============}
function IsComment:boolean;
begin
IsComment:=false;
if pos('/*', text1[nstr])=npos then
begin
IsComment:=true;
TypeComment:=2;
npos:=npos+2;
end
else
if pos('//', text1[nstr])=npos then
begin
IsComment:=true;
TypeComment:=1;
npos:=npos+2;
end;
end;

{=============== ЋЎа Ў®вЄ  Є®¬Ґ­в аЁп =====================}
procedure fComment;
begin
inc(nstr2);
inc(kstr2);
outstr('{');
if TypeComment=1 then
begin
copyn(length(text1[nstr])-npos+1);
outstr('}');
end
else
begin
if pos('*/',text1[nstr])=0 then ferror(3);
copyn(pos('*/',text1[nstr])-npos);
npos:=pos('*/',text1[nstr])+2;
outstr('}');
skipsp;
if npos<=length(text1[nstr]) then ferror(1);
end;
end;
{===================================================}
{=============== ЋЎа Ў®вЄ  ®иЁЎ®Є ==================}
{===================================================}
procedure ferror(err:integer);
begin
{‘ЇЁб®Є  иЁЇ Є:
1: Ї®б«Ґ ®ЇҐа в®а  Ґбвм бЁ¬ў®«л
2: Љ®«ЁзҐбвў® ®вЄалў ойЁебп бЄ®Ў®Є ­Ґ ᮮ⢥вбвўгҐв Є-ўг § Єалў ойЁебп
3: Ќ  бва®ЄҐ N',nstr,' ­Ґ ­ ©¤Ґ­ Є®­Ґж Є®¬Ґ­в аЁп!
4: ­Ґ®Ї®§­ ­­л© Ё¤Ґ­вЁдЁЄ в®а Ё ­Ґ ЇаЁбў Ёў ­ЁҐ
ЂиЁЇЄЁ ў ®ЇҐа в®а е:
5: MAIN
6: DO
7: WHILE
8: PRINTF
9:#DEFINE
10:UNION
11:#INCLUDE
12:FLOAT
13: ЏаЁбў Ёў ­ЁҐ
}
case err of
1:begin
OutStr('{Error: Џ®б«Ґ ®ЇҐа в®а  Ґбвм бЁ¬ў®«л "');
copyn(length(text1[nstr])-npos+1);
OutStr('"}');
end;
2:begin
writeln('Љ®«ЁзҐбвў® "{" ­Ґ ᮮ⢥вбвўгҐв Є-ўг "}"');
writeln('Program aborted!!!');
halt;
end;
3:begin
writeln('Ќ  бва®ЄҐ N',nstr,' ­Ґ ­ ©¤Ґ­ Є®­Ґж Є®¬Ґ­в аЁп!');
writeln('Program aborted!!!');
halt;
end;
4:begin
inc(nstr2);
inc(kstr2);
OutStr('{Error: ­ҐЁ§ўҐбв­л© ®ЇҐа в®а "');
CopyN(length(text1[nstr]));
OutStr('"}');
end;

5:begin
OutStr('{Error: ®иЁЎЄ  ў main: "');
OutStr(text1[nstr]);
OutStr('"}');
end;
6:begin

end;
7:begin
OutStr('{Error: ®иЁЎЄ  ў while: "');
OutStr(text1[nstr]);
OutStr('"}');

end;
8:begin
text2[nstr2]:='{Error: ®иЁЎЄ  ў printf: "'+text1[nstr]+'"}';
end;
9:begin

end;
10:begin

end;
11:begin
inc(nstr2);
inc(kstr2);
text2[nstr2]:='{ЋиЁЎЄ  ў include: "'+text1[nstr]+'"}';
end;
12:begin
text2[nstr2]:='{ЋиЁЎЄ  ў float: "'+text1[nstr]+'"}';
end;

13:begin
text2[nstr2]:='{ЋиЁЎЄ  ў ЇаЁбў Ёў ­ЁЁ: "'+text1[nstr]+'"}';
end;
end;
kerr:=kerr+1;
end;


{======= § ЇЁбм ў ўл室­®© Ї®в®Є бва®ЄЁ s ============}
procedure OutStr(s:string);
begin
text2[nstr2]:=text2[nstr2]+s;
end;

{============ Љ®ЇЁа®ў ­ЁҐ n бЁ¬ў®«®ў Ё б¤ўЁЈ Єгаб®а  ================}
procedure CopyN(n:integer);
begin
text2[nstr2]:=text2[nstr2]+copy(text1[nstr],npos,n);
npos:=npos+n;
end;


{===================== Їа®ЇгбЄ Їа®ЎҐ«®ў ============================}
procedure SkipSp;
begin
while (text1[Nstr,Npos]=' ')
and
(npos<=length(text1[Nstr]))
do inc(npos);
end;

{===================== з⥭ЁҐ д ©«  ў ¬ ббЁў ============================}
procedure readfile;
var ch:char;
begin
{$ifndef debug}
writeln('€¬п д ©«  б Їг⥬: ');
readln(Fname1);
{$else}
Fname1:='F:\KURSOVIK\1.c';
{$endif}

assign(f1,FName1 );
{$i-}
reset(f1);
{$i+}
if IoResult<>0 then
begin
writeln('” ©« '+fname1+' ­Ґ ­ ©¤Ґ­.');
Writeln('Press any key to continue.');
ch:=readkey; Halt;
end;
kstr:=0;
while not eof(f1) do
begin
inc(kstr);readln(f1,text1[kstr]);
end;
close(f1);
end;


{================== § ЇЁбм ¬ ббЁў  ў д ©« ============================}
procedure writefile;
var
i:integer;
ch:char;
begin
{$ifndef debug}
writeln('“Є ¦ЁвҐ Ё¬п ўл室­®Ј® д ©« :');
readln(Fname2);
{$else}
Fname2:='F:\KURSOVIK\1.PAS';
{$endif}

assign(f2,Fname2);
{$i-}
rewrite(f2);
{$i+}
if IoResult<>0 then
begin
writeln('” ©«',Fname2,'­Ґ ­ ©¤Ґ­ .Џ®ўв®аЁвҐ ўў®¤.');
ch:=readkey; Halt;
end;
for i:=1 to kstr2 do
begin
writeln(f2,Text2[i]);
end;
writeln ('—Ёб«® ®иЁЎ®з­ле ®ЇҐа в®а®ў: ',kerr);
writeln('—Ёб«® бва®Є ў Ёб室­®¬ д ©«Ґ: ',kstr);
writeln('—Ёб«® бва®Є ў ўл室­®¬ д ©«Ґ: ', kstr2);
close(f2);
end;


{============================================================}
{===================== ®б­®ў­ п Їа®жҐ¤га  ===================}
{============================================================}
procedure trans;
var i,j:integer;
begin
for i:=1 to kstr do text2[i]:='';

if CheckSk then ferror(2);

while nstr<=kstr do
begin
npos:=1;
SkipSp;
if npos<=length(text1[nstr]) then
if IsComment then
fComment
else
if Kw<>kwNothing then
case kw of
kwOpSk:fOpSk;
kwClSk:fClSk;
kwMain:fMain;
kwDo:fDo;
kwWhile:fWhile;
kwPrintf:fPrintf;
kwDefine:fDefine;
kwUnion:fUnion;
kwInclude:fInclude;
kwFloat:fFloat;
end
else
if not fPrisv then
if un then
begin
text2[NUnStr]:=copy(text1[nstr],npos,pos(';',text1[nstr])-npos);
text2[NUnStr]:=text2[NUnStr]+':record';
text2[NUnStr+1]:=' case integer of';
inc(nstr2);
inc(kstr2);
Outstr('end;');
un:=false;
end
else
fError(4);
inc(nstr);
end;
if not mainflg then
Writeln('‚ Ёб室­®© Їа®Ја ¬¬Ґ ­  C ­Ґв дг­ЄжЁЁ main!!!');
end;


{main}
begin
clrscr;

kstr:=0; kerr:=0; Nstr:=1; Npos:=1; Nstr2:=0; Kstr2:=0;
def:=false; mainflg:=false; v_open:=false; InclFlg:=false;
KolPer:=0; un:=false; nfl:='0';

readfile;
trans;
writefile;
end.