Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program COMPILE;
- uses strutils,classes,sysutils;
- var
- FPAS:text;
- S,SVar:TStringlist; {S,Svar: chứa File lệnh rút gọn, Svar sử dụng để lọc các biến }
- Sint,Sstr,Sarr,stemp,_stemp: TStringlist ;
- x,Strtemp:ansistring;
- procedure addarstr;
- var
- _S:ansistring;
- i,j:integer;
- begin
- Stemp:=Tstringlist.create;
- while pos(' ',strtemp)<>0 do
- begin
- _S:=system.Copy(strtemp,1,pos(' ',strtemp));
- delete(strtemp,1,pos(' ',strtemp));
- stemp.add(_S);
- end;
- if stemp.count>1 then
- begin
- for i:=0 to stemp.count-2 do
- for j:=i+1 to stemp.count-1 do
- begin
- if stemp[i]=Stemp[j] then stemp[j]:=chr($00);
- end;
- end;
- for i:=0 to stemp.count-1 do
- if stemp[i]<>chr($00) then sstr.add(stemp[i]);
- stemp.clear
- end;
- function ktstr(_S:ansistring):boolean;
- var
- _Sr:ansistring;
- a,b:integer;
- begin
- while pos(chr($27),_S)<>0 do
- begin
- a:=pos(chr($27),_S);
- _S[a]:=chr($20);
- B:=pos(chr($27),_S);
- delete(_S,A+1,b-a);
- _S:=_S+' ';
- end;
- _S:=sysutils.StringReplace(_S,'AND',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'XOR',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'OR',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'NOT',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'DIV',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,',',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'+',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'-',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'*',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'/',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'=',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'<',' ',[rfReplaceAll, rfIgnoreCase]);
- _S:=sysutils.StringReplace(_S,'>',' ',[rfReplaceAll, rfIgnoreCase]);
- strtemp:=strtemp+_S;
- strtemp:=strtemp+' ';
- exit(true);
- end;
- Procedure get_strtype;
- var
- Str:ansistring;
- FLAG:boolean;
- I:integer;
- j:integer;
- d:integer;
- begin
- _stemp:=Tstringlist.create;
- for i:=0 to svar.count-1 do
- begin
- Flag:=false;
- str:=Svar[i];
- if pos(chr(39),str)<>0 then
- begin
- _stemp.add(str);
- FLAG:=true;
- end;
- end;
- for i:=0 to _stemp.count-1 do
- begin
- if pos('OUTPUT',_stemp[i])<>0 then _stemp.Delete(i);
- end;
- for i:=0 to _stemp.count-1 do
- begin
- if ktstr(_stemp[i]) then ;
- end;
- while pos(' ',strtemp)<> 0 do
- strtemp:=sysutils.StringReplace(strtemp,' ',' ',[rfReplaceAll, rfIgnoreCase]);
- strtemp:=strtemp+' ';
- _stemp.Clear;
- addarstr ;
- //chuan hoa
- for i:=0 to sstr.count-1 do
- while pos(' ',sstr[i])<> 0 do
- sstr[i]:=sysutils.StringReplace(sstr[i],' ','',[rfReplaceAll, rfIgnoreCase]);
- i:=0;
- while i<sstr.count do
- begin
- if Sstr[i]='' then
- sstr.delete(i)
- else i:=i+1;
- end;
- d:=sstr.count;
- {--------------------------------------------------------------------------}
- for j:=0 to sstr.count-1 do
- for i:=0 to svar.count-1 do
- begin
- Flag:=false;
- str:=Svar[i];
- if pos(sstr[j],str)<>0 then
- begin
- _stemp.add(str);
- FLAG:=true;
- end;
- end;
- for i:=0 to _stemp.count-1 do
- begin
- if pos('OUTPUT',_stemp[i])<>0 then _stemp.Delete(i);
- end;
- for i:=0 to _stemp.count-1 do
- begin
- if ktstr(_stemp[i]) then ;
- end;
- while pos(' ',strtemp)<> 0 do
- strtemp:=sysutils.StringReplace(strtemp,' ',' ',[rfReplaceAll, rfIgnoreCase]);
- strtemp:=strtemp+' ';
- addarstr ;
- _stemp.Destroy;
- {-----------------------------------------------------}
- //Loc lan 2
- if sstr.count>1 then
- begin
- for i:=0 to sstr.count-2 do
- for j:=i+1 to sstr.count-1 do
- begin
- sstr[i]:=sysutils.StringReplace(sstr[i],' ','',[rfReplaceAll, rfIgnoreCase]);
- sstr[j]:=sysutils.StringReplace(sstr[j],' ','',[rfReplaceAll, rfIgnoreCase]);
- if sstr[i] = sstr[j] then
- sstr[j]:='';
- end;
- end;
- //chuan hoa
- while pos(chr(32),sstr[i])<> 0 do
- sstr[i]:=sysutils.StringReplace(sstr[i],chr(32),'',[rfReplaceAll, rfIgnoreCase]);
- i:=0;
- while i<sstr.count do
- begin
- if Sstr[i]='' then
- sstr.delete(i)
- else i:=i+1;
- end;
- end;
- procedure tach_tu_khoa; {xoa tu khoa khoi Svar, Lenh con cua Tach Bien}
- var
- i:integer;
- begin
- x:=sysutils.StringReplace(x,'LOOP',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'START',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'INPUT',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'OUTPUT',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'{',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'}',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'FINISH',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'THEN',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'IF',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'AND',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'XOR',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'OR',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'NOT',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'DIV',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,',',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'+',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'-',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'*',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'/',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'=',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'>',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=sysutils.StringReplace(x,'<',' ',[rfReplaceAll, rfIgnoreCase]);
- end;
- procedure phanloai;
- var
- i,j,_X,_F:integer;
- _S:ansistring;
- begin
- for i:=0 to stemp.count-1 do
- while pos(chr(32),stemp[i])<> 0 do
- stemp[i]:=sysutils.StringReplace(stemp[i],chr(32),'',[rfReplaceAll, rfIgnoreCase]);
- for i:=0 to stemp.count-1 do
- begin
- if pos('[',stemp[i])<> 0 then
- begin
- _S:=copy(stemp[i],1,pos('[',stemp[i])-1);
- sarr.Add(_S);
- Stemp[i]:='';
- end else
- if pos(chr($27),stemp[i])<>0 then stemp[i]:='';
- _S:=stemp[i];
- val(stemp[i],_X,_F);
- if _F = 0 then stemp[i]:='';
- end;
- sarr.savetofile('TEMP');
- for i:=0 to stemp.count-1 do
- if stemp[i]<>'' then sint.add(stemp[i]);
- stemp.clear;;
- for i:=0 to Sarr.count-2 do
- for j:=i+1 to sarr.count-1 do
- if Sarr[i]=Sarr[j] then sarr[j]:='';
- i:=0;
- while i<sarr.count do
- if sarr[i]='' then sarr.delete(i) else inc(i);
- end;
- procedure loc_inttype;
- var
- i,j,k:integer;
- F:boolean;
- mark:integer;
- l:integer;
- _S,_str,d:ansistring;
- c:char;
- begin
- stemp:=tstringlist.create;
- for i:=0 to sstr.count-1 do
- x:=sysutils.StringReplace(x,sstr[i],'',[rfReplaceAll, rfIgnoreCase]);
- while pos(' ',x)<> 0 do
- x:=sysutils.StringReplace(x,' ',' ',[rfReplaceAll, rfIgnoreCase]);
- x:=x+' ' ;
- if x[1]=' ' then delete(x,1,1);
- while pos(' ',x)<>0 do
- begin
- _S:=system.Copy(x,1,pos(' ',x));
- delete(x,1,pos(' ',x));
- stemp.add(_S);
- end;
- i:=0;
- F:=true;
- j:=1;
- _str:='';
- while i<stemp.count-1 do
- begin
- j:=1;
- while j<length(stemp[i]) do
- begin
- d:= stemp[i];
- c:=stemp[i][j];
- if stemp[i][j]=chr($27) then
- begin
- mark:=i;
- _str:=_str+stemp[i][j];
- inc(j);
- while stemp[i][j] <> chr($27) do
- begin
- d:= stemp[i];
- c:=stemp[i][j];
- if j>length(stemp[i]) then
- begin
- inc(i);
- j:=1;
- if stemp[i][j]=chr($27) then break;
- end;
- if i>stemp.count-1 then break;
- _str:=_str+stemp[i][j];
- inc(j);
- end;
- _str:=_str+chr($27);
- for k:=1 to i-mark do
- begin
- dec(i);
- stemp.delete(mark+1);
- end;
- Stemp[mark]:=_str;
- _str:='';
- end else
- inc(j);
- end;
- inc(i);
- end;
- {-------------------------------------------------------------------}
- for i:=0 to stemp.count-1 do
- while pos(' ',stemp[i])<> 0 do
- stemp[i]:=sysutils.StringReplace(stemp[i],' ',' ',[rfReplaceAll, rfIgnoreCase]);
- //Loc lan 2
- if stemp.count>1 then
- begin
- for i:=0 to stemp.count-2 do
- for j:=i+1 to stemp.count-1 do
- begin
- if stemp[i] = stemp[j] then
- stemp[j]:='';
- end;
- end;
- //chuan hoa
- for i:=0 to stemp.count-1 do
- while pos(' ',stemp[i])<> 0 do
- stemp[i]:=sysutils.StringReplace(stemp[i],' ',' ',[rfReplaceAll, rfIgnoreCase]);
- i:=0;
- while i<stemp.count do
- begin
- l:=stemp.count;
- d:=stemp[i];
- if stemp[i]='' then
- stemp.delete(i)
- else i:=i+1;
- end;
- phanloai;
- end;
- procedure get_type;
- begin
- loc_inttype;
- stemp:=tstringlist.create;
- end;
- procedure tachbien;
- var
- i:integer;
- begin
- x:='';
- for i:=0 to Svar.count-1 do
- x:=x+Svar[i]+' ';
- tach_tu_khoa;
- get_strtype;
- get_type;
- end;
- procedure init;
- var
- i:integer;
- begin
- Sint:= tstringlist.Create;
- Sstr:= tstringlist.Create;
- Sarr:= tstringlist.Create;
- S:=tstringlist.Create;
- Svar:=tstringlist.create;
- S.LoadFromFile('DEMO.txt');
- For i:=0 to s.count-1 do
- S[i]:=upcase(s[i]);
- Svar:=S;
- tachbien;
- end;
- procedure writearr;
- var
- i:integer;
- begin
- assign(FPAS,'_SAMPLE.PAS');
- rewrite(fpas);
- writeln(fpas,'uses math');
- writeln(fpas,'var');
- write(fpas,chr($9));
- writeln(fpas,'_I: integer;');
- write(fpas,chr($9));
- write(fpas,sstr[0]);
- for i:=1 to sstr.count-1 do
- write(fpas,','+sstr[i]);
- writeln(fpas,': ansistring;');
- write(fpas,chr($9));
- write(fpas,sint[0]);
- for i:=1 to sint.count-1 do
- write(fpas,','+sint[i]);
- writeln(fpas,': integer;');
- write(fpas,chr($9));
- write(fpas,sarr[0]);
- for i:=1 to sarr.count-1 do
- write(fpas,','+sarr[i]);
- writeln(fpas,': array [-1000..1000] of integer;');
- writeln(fpas,'BEGIN');
- end;
- begin
- init;
- writearr;
- writeln(fpas,'END.');
- close(fpas);
- end .
Add Comment
Please, Sign In to add comment