[Back to PARSING SWAG index] [Back to Main SWAG index] [Original]

    {
    >      Is there a standard of "best" algorithm used to convert algebraic format
    > statements, such as a Pascal assignment statement, to a postfix format, such
    > as usually used inside the compiler in preparation to generating machine
    > language object file?

    >      Or, to put it another way, what is the best know way to convert
    >           X := 4*(Lastval + Curval)/3.0;
    >      to
    >           Lastval, Curval + 4 * 3.0 /
    >       ?
    >                                        Joel Lichtenwalner

    I don't know about the best or standard, but I recently wrote a procedure
    that does this without using any recursion or stacks. OK, it uses a few
    array's to hold few WORD's.

    What's nice about it is that it allows for only 4 temperary values to be
    stored, which can be expanded to mean AX,BX,CX and DX. (You can increase this
    to whatever you want) What's even nicer is that I have not been able to
    write an infix expression complex enough to use more than 2 of the 4
    temperary variables! It's very short, so I added it to the message (you may
    flame me with your newest gem ... :)
    {-----------------------------------------------------------------------}

    const

       OpChars = ['+','-','/','*']; {These two sets must be mutually exclusive}

       SymbolChars=['a'..'z','A'..'Z','0'..'9','.','_'];

    const

       TempVars:string='adcb';{The 4 temporary variables (or registers)}

    function GetTempResult(s:string):char;
    {Returns the best place to store the temporary result}
       var n,c:integer; p:array[1..5] of byte;
       begin
          c:=0;
          for n:=1 to length(s) do if s[n] in ['a'..'d'] then begin
             inc(c);
             p[c]:=n;
          end;
          case c of
             0:begin
                GetTempResult:=TempVars[1];
                delete(TempVars,1,1);
             end;
             1:GetTempResult:=s[p[1]];
             else begin
                for n:=2 to c do TempVars:=s[p[n]]+TempVars;
                GetTempResult:=s[p[1]];
             end;
          end;
       end;

    function Priority(s:string):byte;
    {Returns the oprator's priority}
       begin
          if length(s)=1 then
             case s[1] of
                '+','-':Priority:=0;
                '*','/':Priority:=1;
             end
          else;
       end;

    procedure Error(S:string);
    {Reports an error}
       begin
          writeln(';***Error***: ',S);
          Halt;
       end;

    function PostFix(InFix:string):string;
       var
          Ops:array[1..255] of byte;{Allows only <=255 operators in one...}
          Pri:array[1..255] of word;{...expression}
          OC,n,L,R,Shell,MaxOp:integer;
          LS,Op,RS:string;
       begin
          OC:=0;
          Shell:=0;
          MaxOp:=1;
          n:=1;
          while n<=length(InFix) do begin
             if Infix[n] in OpChars then begin
                R:=n;
                while (R<length(InFix)) and (InFix[R] in OpChars) do inc(R);
                Op:=copy(InFix,n,R-n);
                inc(OC);
                Ops[OC]:=n;
                Pri[OC]:=Priority(Op)+Shell;
                if Pri[OC]>=Pri[MaxOp] then MaxOp:=OC;
                n:=R-1;
             end else
             case InFix[n] of
                '(':inc(Shell,100);{Allows for 100 levels of priorities...}
                ')':dec(Shell,100);{...for operators}
             end;
             inc(n);
           end;
           if Shell>0 then Error('Too few ")".');{Although I report this errors...}
           if Shell<0 then Error('Too few "(".');{... the procedure still works...}
                                                 {...if you don't}
           while OC>0 do begin
              n:=Ops[MaxOp]-1;  {Read Left Parameter}
              while (n>0) and not(InFix[n] in SymbolChars) do dec(n);
              L:=n;
              while (L>0) and (InFix[L] in SymbolChars) do dec(L);
              LS:=copy(InFix,L+1,n-L);

              n:=Ops[MaxOp]+1; {Read Right Paramter}
              while (n<=length(InFix)) and not(InFix[n] in SymbolChars) do inc(n);
              R:=n;
              while (R<=length(InFix)) and (InFix[R] in SymbolChars) do inc(R);
              RS:=copy(InFix,n,R-n);
              {PS. Only allows for 2 parameter ops.}

              Op:=GetTempResult(LS+RS);
              writeln(LS,RS,InFix[Ops[MaxOp]],' -> ',Op);

              InFix[L+1]:=Op[1]; InFix[L+2]:=' ';
              InFix[R-1]:=Op[1]; InFix[R-2]:=' ';

              dec(OC);
              for n:=MaxOp to OC do begin
                 Pri[n]:=Pri[n+1];
                 Ops[n]:=Ops[n+1];
              end;
              if MaxOp>OC then dec(MaxOp);
              while (MaxOp>1) and (Pri[MaxOp-1]>Pri[MaxOp]) do dec(MaxOp);
           end;
           PostFix:=Op;
        end;

     var Infix:string;
     begin
        Infix:='(A+B)+(B/B+A*(C-D)+(E-F*G+H))';
        writeln(InFix);
        writeln(PostFix(InFix));
        readln;
     end.

[Back to PARSING SWAG index] [Back to Main SWAG index] [Original]