SHARE
TWEET

COMPILE.PAS

finalshare Jul 13th, 2016 (edited) 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program COMPILE;
  2. uses strutils,classes,sysutils;
  3.  
  4. var
  5.         FPAS:text;
  6.         S,SVar:TStringlist;  {S,Svar: chứa File lệnh rút gọn, Svar sử dụng để lọc các biến }
  7.         Sint,Sstr,Sarr,stemp,_stemp:  TStringlist ;
  8.         x,Strtemp:ansistring;
  9.  
  10. procedure addarstr;
  11. var
  12.    _S:ansistring;
  13.    i,j:integer;
  14.  
  15. begin
  16.   Stemp:=Tstringlist.create;
  17.   while pos(' ',strtemp)<>0 do
  18.         begin
  19.              _S:=system.Copy(strtemp,1,pos(' ',strtemp));
  20.              delete(strtemp,1,pos(' ',strtemp));
  21.              stemp.add(_S);
  22.  
  23.         end;
  24.   if stemp.count>1 then
  25.      begin
  26.      for i:=0 to stemp.count-2 do
  27.        for j:=i+1 to stemp.count-1 do
  28.            begin
  29.                if stemp[i]=Stemp[j] then stemp[j]:=chr($00);
  30.            end;
  31.      end;
  32.   for i:=0 to stemp.count-1 do
  33.     if stemp[i]<>chr($00) then sstr.add(stemp[i]);
  34.   stemp.clear
  35. end;
  36.  
  37. function ktstr(_S:ansistring):boolean;
  38. var
  39.         _Sr:ansistring;
  40.         a,b:integer;
  41.  
  42. begin
  43.  
  44.     while pos(chr($27),_S)<>0 do
  45.        begin
  46.        a:=pos(chr($27),_S);
  47.        _S[a]:=chr($20);
  48.        B:=pos(chr($27),_S);
  49.        delete(_S,A+1,b-a);
  50.        _S:=_S+' ';
  51.        end;
  52.  
  53.   _S:=sysutils.StringReplace(_S,'AND',' ',[rfReplaceAll, rfIgnoreCase]);
  54.   _S:=sysutils.StringReplace(_S,'XOR',' ',[rfReplaceAll, rfIgnoreCase]);
  55.   _S:=sysutils.StringReplace(_S,'OR',' ',[rfReplaceAll, rfIgnoreCase]);
  56.   _S:=sysutils.StringReplace(_S,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
  57.   _S:=sysutils.StringReplace(_S,'NOT',' ',[rfReplaceAll, rfIgnoreCase]);
  58.   _S:=sysutils.StringReplace(_S,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
  59.   _S:=sysutils.StringReplace(_S,'DIV',' ',[rfReplaceAll, rfIgnoreCase]);
  60.   _S:=sysutils.StringReplace(_S,',',' ',[rfReplaceAll, rfIgnoreCase]);
  61.   _S:=sysutils.StringReplace(_S,'+',' ',[rfReplaceAll, rfIgnoreCase]);
  62.   _S:=sysutils.StringReplace(_S,'-',' ',[rfReplaceAll, rfIgnoreCase]);
  63.   _S:=sysutils.StringReplace(_S,'*',' ',[rfReplaceAll, rfIgnoreCase]);
  64.   _S:=sysutils.StringReplace(_S,'/',' ',[rfReplaceAll, rfIgnoreCase]);
  65.   _S:=sysutils.StringReplace(_S,'=',' ',[rfReplaceAll, rfIgnoreCase]);
  66.   _S:=sysutils.StringReplace(_S,'<',' ',[rfReplaceAll, rfIgnoreCase]);
  67.   _S:=sysutils.StringReplace(_S,'>',' ',[rfReplaceAll, rfIgnoreCase]);
  68.  
  69.   strtemp:=strtemp+_S;
  70.   strtemp:=strtemp+' ';
  71.   exit(true);
  72.  
  73. end;
  74.  
  75.  
  76. Procedure get_strtype;
  77. var
  78.         Str:ansistring;
  79.         FLAG:boolean;
  80.         I:integer;
  81.         j:integer;
  82.         d:integer;
  83. begin
  84.   _stemp:=Tstringlist.create;
  85.   for i:=0 to svar.count-1 do
  86.               begin
  87.                 Flag:=false;
  88.                 str:=Svar[i];
  89.                 if pos(chr(39),str)<>0 then
  90.                    begin
  91.                    _stemp.add(str);
  92.                    FLAG:=true;
  93.                    end;
  94.               end;
  95.  
  96.      for i:=0 to _stemp.count-1 do
  97.               begin
  98.                 if pos('OUTPUT',_stemp[i])<>0 then _stemp.Delete(i);
  99.               end;
  100.      for i:=0 to _stemp.count-1 do
  101.               begin
  102.                    if ktstr(_stemp[i]) then ;
  103.               end;
  104.      while pos('  ',strtemp)<> 0 do
  105.   strtemp:=sysutils.StringReplace(strtemp,'  ',' ',[rfReplaceAll, rfIgnoreCase]);
  106.      strtemp:=strtemp+' ';
  107.      _stemp.Clear;
  108.  
  109.      addarstr  ;
  110.      //chuan hoa
  111.      for i:=0 to sstr.count-1 do
  112.        while pos(' ',sstr[i])<> 0 do
  113.   sstr[i]:=sysutils.StringReplace(sstr[i],' ','',[rfReplaceAll, rfIgnoreCase]);
  114.      i:=0;
  115.      while i<sstr.count do
  116.            begin
  117.                if Sstr[i]='' then
  118.                   sstr.delete(i)
  119.                else i:=i+1;
  120.  
  121.            end;
  122.      d:=sstr.count;
  123.  {--------------------------------------------------------------------------}
  124.      for j:=0 to sstr.count-1 do
  125.  
  126.      for i:=0 to svar.count-1 do
  127.               begin
  128.                 Flag:=false;
  129.                 str:=Svar[i];
  130.                 if pos(sstr[j],str)<>0 then
  131.                    begin
  132.                    _stemp.add(str);
  133.                    FLAG:=true;
  134.                    end;
  135.               end;
  136.   for i:=0 to _stemp.count-1 do
  137.               begin
  138.                 if pos('OUTPUT',_stemp[i])<>0 then _stemp.Delete(i);
  139.               end;
  140.      for i:=0 to _stemp.count-1 do
  141.               begin
  142.                    if ktstr(_stemp[i]) then ;
  143.               end;
  144.      while pos('  ',strtemp)<> 0 do
  145.   strtemp:=sysutils.StringReplace(strtemp,'  ',' ',[rfReplaceAll, rfIgnoreCase]);
  146.      strtemp:=strtemp+' ';
  147.      addarstr  ;
  148.  
  149.      _stemp.Destroy;
  150.      {-----------------------------------------------------}
  151.  
  152.      //Loc lan 2
  153.   if sstr.count>1 then
  154.      begin
  155.      for i:=0 to sstr.count-2 do
  156.        for j:=i+1 to sstr.count-1 do
  157.            begin
  158.                 sstr[i]:=sysutils.StringReplace(sstr[i],' ','',[rfReplaceAll, rfIgnoreCase]);
  159.     sstr[j]:=sysutils.StringReplace(sstr[j],' ','',[rfReplaceAll, rfIgnoreCase]);
  160.                if sstr[i] = sstr[j] then
  161.                 sstr[j]:='';
  162.            end;
  163.      end;
  164.         //chuan hoa
  165.       while pos(chr(32),sstr[i])<> 0 do
  166.   sstr[i]:=sysutils.StringReplace(sstr[i],chr(32),'',[rfReplaceAll, rfIgnoreCase]);
  167.      i:=0;
  168.      while i<sstr.count do
  169.            begin
  170.                if Sstr[i]='' then
  171.                   sstr.delete(i)
  172.                else i:=i+1;
  173.            end;
  174. end;
  175.  
  176. procedure tach_tu_khoa; {xoa tu khoa khoi Svar, Lenh con cua Tach Bien}
  177. var
  178.         i:integer;
  179. begin
  180.   x:=sysutils.StringReplace(x,'LOOP',' ',[rfReplaceAll, rfIgnoreCase]);
  181.   x:=sysutils.StringReplace(x,'START',' ',[rfReplaceAll, rfIgnoreCase]);
  182.   x:=sysutils.StringReplace(x,'INPUT',' ',[rfReplaceAll, rfIgnoreCase]);
  183.   x:=sysutils.StringReplace(x,'OUTPUT',' ',[rfReplaceAll, rfIgnoreCase]);
  184.   x:=sysutils.StringReplace(x,'{',' ',[rfReplaceAll, rfIgnoreCase]);
  185.   x:=sysutils.StringReplace(x,'}',' ',[rfReplaceAll, rfIgnoreCase]);
  186.   x:=sysutils.StringReplace(x,'FINISH',' ',[rfReplaceAll, rfIgnoreCase]);
  187.   x:=sysutils.StringReplace(x,'THEN',' ',[rfReplaceAll, rfIgnoreCase]);
  188.   x:=sysutils.StringReplace(x,'IF',' ',[rfReplaceAll, rfIgnoreCase]);
  189.   x:=sysutils.StringReplace(x,'AND',' ',[rfReplaceAll, rfIgnoreCase]);
  190.   x:=sysutils.StringReplace(x,'XOR',' ',[rfReplaceAll, rfIgnoreCase]);
  191.   x:=sysutils.StringReplace(x,'OR',' ',[rfReplaceAll, rfIgnoreCase]);
  192.   x:=sysutils.StringReplace(x,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
  193.   x:=sysutils.StringReplace(x,'NOT',' ',[rfReplaceAll, rfIgnoreCase]);
  194.   x:=sysutils.StringReplace(x,'MOD',' ',[rfReplaceAll, rfIgnoreCase]);
  195.   x:=sysutils.StringReplace(x,'DIV',' ',[rfReplaceAll, rfIgnoreCase]);
  196.   x:=sysutils.StringReplace(x,',',' ',[rfReplaceAll, rfIgnoreCase]);
  197.   x:=sysutils.StringReplace(x,'+',' ',[rfReplaceAll, rfIgnoreCase]);
  198.   x:=sysutils.StringReplace(x,'-',' ',[rfReplaceAll, rfIgnoreCase]);
  199.   x:=sysutils.StringReplace(x,'*',' ',[rfReplaceAll, rfIgnoreCase]);
  200.   x:=sysutils.StringReplace(x,'/',' ',[rfReplaceAll, rfIgnoreCase]);
  201.   x:=sysutils.StringReplace(x,'=',' ',[rfReplaceAll, rfIgnoreCase]);
  202.   x:=sysutils.StringReplace(x,'>',' ',[rfReplaceAll, rfIgnoreCase]);
  203.   x:=sysutils.StringReplace(x,'<',' ',[rfReplaceAll, rfIgnoreCase]);
  204.  
  205. end;
  206.  
  207. procedure phanloai;
  208. var
  209.    i,j,_X,_F:integer;
  210.    _S:ansistring;
  211. begin
  212.     for i:=0 to stemp.count-1 do
  213.               while pos(chr(32),stemp[i])<> 0 do
  214.   stemp[i]:=sysutils.StringReplace(stemp[i],chr(32),'',[rfReplaceAll, rfIgnoreCase]);
  215.  
  216.   for i:=0 to stemp.count-1 do
  217.          begin
  218.              if pos('[',stemp[i])<> 0 then
  219.                 begin
  220.                     _S:=copy(stemp[i],1,pos('[',stemp[i])-1);
  221.                     sarr.Add(_S);
  222.                     Stemp[i]:='';
  223.                 end else
  224.              if pos(chr($27),stemp[i])<>0 then stemp[i]:='';
  225.               _S:=stemp[i];
  226.                val(stemp[i],_X,_F);
  227.              if _F = 0 then stemp[i]:='';
  228.          end;
  229.   sarr.savetofile('TEMP');
  230.   for i:=0 to stemp.count-1 do
  231.       if stemp[i]<>'' then sint.add(stemp[i]);
  232.   stemp.clear;;
  233.   for i:=0 to Sarr.count-2 do
  234.       for j:=i+1 to sarr.count-1 do
  235.           if Sarr[i]=Sarr[j] then sarr[j]:='';
  236.   i:=0;
  237.  
  238.   while i<sarr.count do
  239.         if sarr[i]='' then sarr.delete(i) else inc(i);
  240. end;
  241.  
  242. procedure loc_inttype;
  243. var
  244.         i,j,k:integer;
  245.         F:boolean;
  246.         mark:integer;
  247.         l:integer;
  248.         _S,_str,d:ansistring;
  249.         c:char;
  250. begin
  251.    stemp:=tstringlist.create;
  252.   for i:=0 to sstr.count-1 do
  253.         x:=sysutils.StringReplace(x,sstr[i],'',[rfReplaceAll, rfIgnoreCase]);
  254.     while pos('  ',x)<> 0 do
  255.   x:=sysutils.StringReplace(x,'  ',' ',[rfReplaceAll, rfIgnoreCase]);
  256.      x:=x+' ' ;
  257.      if x[1]=' '  then delete(x,1,1);
  258.        while pos(' ',x)<>0 do
  259.         begin
  260.              _S:=system.Copy(x,1,pos(' ',x));
  261.              delete(x,1,pos(' ',x));
  262.              stemp.add(_S);
  263.  
  264.         end;
  265.        i:=0;
  266.        F:=true;
  267.        j:=1;
  268.        _str:='';
  269.        while i<stemp.count-1 do
  270.              begin
  271.                  j:=1;
  272.                  while j<length(stemp[i]) do
  273.                        begin
  274.                            d:= stemp[i];
  275.                            c:=stemp[i][j];
  276.                            if stemp[i][j]=chr($27) then
  277.                               begin
  278.                                    mark:=i;
  279.                                    _str:=_str+stemp[i][j];
  280.                                    inc(j);
  281.                                    while stemp[i][j] <> chr($27) do
  282.                                          begin
  283.                                               d:= stemp[i];
  284.                                               c:=stemp[i][j];
  285.                                               if j>length(stemp[i]) then
  286.                                                  begin
  287.                                                  inc(i);
  288.                                                  j:=1;
  289.                                                  if stemp[i][j]=chr($27) then break;
  290.                                                  end;
  291.                                               if i>stemp.count-1 then break;
  292.                                               _str:=_str+stemp[i][j];
  293.                                               inc(j);
  294.                                          end;
  295.                          _str:=_str+chr($27);
  296.                          for k:=1 to i-mark do
  297.                            begin
  298.                                dec(i);
  299.                              stemp.delete(mark+1);
  300.                            end;
  301.                          Stemp[mark]:=_str;
  302.                         _str:='';
  303.                         end else
  304.                          inc(j);
  305.                        end;
  306.                  inc(i);
  307.              end;
  308.         {-------------------------------------------------------------------}
  309.         for i:=0 to stemp.count-1 do
  310.         while pos('  ',stemp[i])<> 0 do
  311.   stemp[i]:=sysutils.StringReplace(stemp[i],'  ',' ',[rfReplaceAll, rfIgnoreCase]);
  312.         //Loc lan 2
  313.   if stemp.count>1 then
  314.      begin
  315.      for i:=0 to stemp.count-2 do
  316.        for j:=i+1 to stemp.count-1 do
  317.            begin
  318.                if stemp[i] = stemp[j] then
  319.                 stemp[j]:='';
  320.            end;
  321.      end;
  322.         //chuan hoa
  323.                 for i:=0 to stemp.count-1 do
  324.         while pos('  ',stemp[i])<> 0 do
  325.   stemp[i]:=sysutils.StringReplace(stemp[i],'  ',' ',[rfReplaceAll, rfIgnoreCase]);
  326.      i:=0;
  327.      while i<stemp.count do
  328.            begin
  329.                 l:=stemp.count;
  330.                 d:=stemp[i];
  331.                if stemp[i]='' then
  332.                   stemp.delete(i)
  333.                else i:=i+1;
  334.  
  335.            end;
  336.          phanloai;
  337. end;
  338.  
  339. procedure get_type;
  340. begin
  341.  loc_inttype;
  342.  stemp:=tstringlist.create;
  343. end;
  344.  
  345.  
  346. procedure tachbien;
  347. var
  348.    i:integer;
  349. begin
  350.     x:='';
  351.     for i:=0 to Svar.count-1 do
  352.         x:=x+Svar[i]+' ';
  353.  
  354.     tach_tu_khoa;
  355.     get_strtype;
  356.     get_type;
  357. end;
  358.  
  359. procedure init;
  360. var
  361.    i:integer;
  362. begin
  363.   Sint:=  tstringlist.Create;
  364.   Sstr:=  tstringlist.Create;
  365.   Sarr:=  tstringlist.Create;
  366.   S:=tstringlist.Create;
  367.   Svar:=tstringlist.create;
  368.   S.LoadFromFile('DEMO.txt');
  369.   For i:=0 to s.count-1 do
  370.         S[i]:=upcase(s[i]);
  371.       Svar:=S;
  372.   tachbien;
  373.  
  374. end;
  375. procedure writearr;
  376. var
  377.    i:integer;
  378. begin
  379.    assign(FPAS,'_SAMPLE.PAS');
  380.    rewrite(fpas);
  381.    writeln(fpas,'uses math');
  382.    writeln(fpas,'var');
  383.    write(fpas,chr($9));
  384.    writeln(fpas,'_I: integer;');
  385.  
  386.    write(fpas,chr($9));
  387.    write(fpas,sstr[0]);
  388.    for i:=1 to sstr.count-1 do
  389.        write(fpas,','+sstr[i]);
  390.    writeln(fpas,': ansistring;');
  391.  
  392.    write(fpas,chr($9));
  393.    write(fpas,sint[0]);
  394.    for i:=1 to sint.count-1 do
  395.              write(fpas,','+sint[i]);
  396.    writeln(fpas,': integer;');
  397.  
  398.    write(fpas,chr($9));
  399.    write(fpas,sarr[0]);
  400.    for i:=1 to sarr.count-1 do
  401.              write(fpas,','+sarr[i]);
  402.    writeln(fpas,': array [-1000..1000] of integer;');
  403.  
  404.  
  405.    writeln(fpas,'BEGIN');
  406. end;
  407.  
  408. begin
  409.   init;
  410.   writearr;
  411.   writeln(fpas,'END.');
  412.   close(fpas);
  413. end .
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top