old/PAS/lex.pas

const
     DEY = ['+','-','*','/'];
Type
  PBTree = ^TBTree;
  TBTree = record
    info : char;
    Left : PBTree;
    Right: PBTree;
  end;

    ps  = ^el;
    el  = record
        data : integer;
        prev : ps;
    end;
Var
  inp : string;
  p   : byte;
  tree: PBTree;
  out : string;

Procedure BackPolsk(Tr:PBTree);
begin
  if ((Tr^.left^.left<>nil) and (Tr^.left^.right<>nil)) then BackPolsk(Tr^.left);
  out := out+Tr^.left^.info;
  if ((Tr^.right^.left<>nil) and (Tr^.right^.right<>nil)) then BackPolsk(Tr^.right);
  out := out+Tr^.right^.info;
end;
{---------------------------------}
Procedure DelBranch(br:PBTree);
begin
  if br^.left <> nil then DelBranch(br^.left);
  if br^.right <> nil then DelBranch(br^.right);
  Dispose(br);
end;{DelBranch}

{-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=--=-=-=-=-=-=-}
Procedure Create(TR:PBTree);
begin
 New(Tr^.left);
 Tr^.left^.right:=nil;
 Tr^.left^.left:=nil;
 if inp[p] = '(' then 
  begin 
   inc(p);
   Create(tr^.left);
  end
 else 
  tr^.left^.info := inp[p];

 inc(P);
 tr^.info := inp[p];
 inc(p);
 new(tr^.right);
 Tr^.right^.right:=nil;
 Tr^.right^.left:=nil;
 if (inp[p]='(') then 
  begin 
   inc(p);
   Create(tr^.right) 
  end
 else 
  tr^.right^.info := inp[p];

 if (inp[p+1]=')') then inc(p);
end;{---=--=--=-=-=-=-=-=---=-=-=-=-=--}

Procedure PUSH(i:integer;var head:ps);
var ne : ps;
begin
  New(ne);
  ne^.data := i;
  ne^.prev := head;
  head := ne;
end;

Function POP(var head:ps):integer;
var ret:integer;newhead:ps;
begin
  ret := head^.data;
  newhead := head^.prev;
  Dispose(head);
  head := newhead;
  POP := ret;
end;
{-=-=-=-=-===-=-=-=-=-=-=-=-=-=-=-=-=-}

Procedure MakeD(var num1:integer;num2:integer;dey:char);
begin
  case dey of
    '+': num1 := num1 + num2;
    '-': num1 := num1 - num2;
    '*': num1 := num1 * num2;
    '/': if num2 <> 0 then num1 := num1 div num2;
  end;
end;
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-}
Procedure Calculate(polsk:string;var header : ps);
Var
   pos1   : byte;
   num1,
   num2   : integer;
begin
 for pos1 := 1 to length(polsk) do
   begin
     if polsk[pos1] in dey then
       begin
         num2 := POP(header);
         num1 := POP(header);
         makeD(num1,num2,polsk[pos1]);
         PUSH(num1,header);
       end
     else
      begin
        num1:=ord(polsk[pos1])-ord('0');
        PUSH(num1,header);
      end;
   end;
end;
{--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=--}
var
 header:ps;
{--------------------------------------}
Begin
  New(Tree);
  Tree^.left:=nil;
  Tree^.right:=nil;
  p:=1;
  WriteLn('Enter expression, using brackets:');
  readln(inp);
  Create(tree);
  out :='';
  BackPolsk(tree);
  out:=out+Tree^.info;
  DelBranch(tree);
  header^.prev:=nil;
  Calculate(out,header);
  WriteLn('Back polsk record: ',out);
  WriteLN('Result: ',POP(header));
  Readln;
End.