COMPILE.PAS

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 .