Arithmetic evaluation/Delphi

<lang Delphi> program Arithmetic_evaluation;

{$APPTYPE CONSOLE}

 System.SysUtils;

type

 NodeType = (binop, number, error);

 pAstNode = ^tAstNode;

 tAstNode = record
   typ: NodeType;
   operation: char;
   first, second: pAstNode;
   value: integer;
 end;

 TASTParse = class
 private
   fCh: char;
   FExpression: string;
   FResult: Integer;
   fAst: pAstNode;
   FEvalError: boolean;
   procedure Get;
   procedure skipWhitespace;
   function parseAddSub: pAstNode;
   function parseValue: pAstNode;
   function parseMulDiv: pAstNode;
   procedure disposeTree(tree: pAstNode);
   function newBinOp(op: char; left: pAstNode): pAstNode;
   function eval(ast: pAstNode): integer;
 public
   function TryParse(Expression: string; var aResult: Integer): boolean; overload;
   function TryParse(Expression: string): boolean; overload;
   function Parse(Expression: string): Integer; overload;
   function Parse(Expression: string; var aResult: Integer): boolean; overload;
   constructor Create(); overload;
   constructor Create(Expression: string); overload;
   destructor Destroy; override;
   property Result: Integer read FResult;
 end;

function TASTParse.newBinOp(op: char; left: pAstNode): pAstNode; var

 node: pAstNode;

begin

 new(node);
 node^.typ := binop;
 node^.operation := op;
 node^.first := left;
 node^.second := nil;
 newBinOp := node;

end;

function TASTParse.Parse(Expression: string): Integer; begin

 TryParse(Expression);
 Result := FResult;

end;

function TASTParse.Parse(Expression: string; var aResult: Integer): boolean; begin

 Result := TryParse(Expression);
 aResult := FResult;

end;

procedure TASTParse.disposeTree(tree: pAstNode); begin

 if tree^.typ = binop then
 begin
   if (tree^.first <> nil) then
     disposeTree(tree^.first);
   if (tree^.second <> nil) then
     disposeTree(tree^.second)
 end;
 dispose(tree);

end;

procedure TASTParse.skipWhitespace; var

 ch: char;

 function isWhite: boolean;
 begin
   isWhite := false;
   if not (fCh = #0) then
     if fCh = ' ' then
       isWhite := true
 end;

begin

 while isWhite do
   Get;

end;

function TASTParse.TryParse(Expression: string; var aResult: Integer): boolean; var

 value: integer;

begin

 FExpression := Expression;
 Get;
 fAst := parseAddSub;
 Result := not ((fast^.typ = error) or not (fCh = #0));
 if not Result then
   exit;

 FEvalError := False;
 value := eval(fAst);
 Result := not FEvalError;

 if not Result then
   exit;

 FResult := value;
 aResult := FResult;

end;

function TASTParse.TryParse(Expression: string): boolean; begin

 Result := TryParse(Expression, FResult);

end;

function TASTParse.parseAddSub: pAstNode; var

 node1, node2: pAstNode;
 continue: boolean;

begin

 node1 := parseMulDiv;
 if node1^.typ <> error then
 begin
   continue := true;
   while continue and not (fCh = #0) do
   begin
     skipWhitespace;
     if fCh in ['+', '-'] then
     begin
       node1 := newBinop(fCh, node1);
       get;
       node2 := parseMulDiv;
       if (node2^.typ = error) then
       begin
         disposeTree(node1);
         node1 := node2;
         continue := false
       end
       else
         node1^.second := node2
     end
     else
       continue := false
   end;
 end;
 parseAddSub := node1;

end;

function TASTParse.parseMulDiv: pAstNode; var

 node1, node2: pAstNode;
 continue: boolean;

begin

 node1 := parseValue;
 if node1^.typ <> error then
 begin
   continue := true;
   while continue and not (fch = #0) do
   begin
     skipWhitespace;
     if fCh in ['*', '/'] then
     begin
       node1 := newBinop(fCh, node1);
       get;
       node2 := parseValue;
       if (node2^.typ = error) then
       begin
         disposeTree(node1);
         node1 := node2;
         continue := false
       end
       else
         node1^.second := node2
     end
     else
       continue := false
   end;
 end;
 parseMulDiv := node1;

end;

function TASTParse.parseValue: pAstNode; var

 node: pAstNode;
 value: integer;
 neg: boolean;

begin

 node := nil;
 skipWhitespace;
 if fCh = '(' then
 begin
   get;
   node := parseAddSub;
   if node^.typ <> error then
   begin
     skipWhitespace;
     if fCh = ')' then
       get
     else
     begin
       disposeTree(node);
       new(node);
       node^.typ := error;
     end
   end
 end
 else if fCh in ['0'..'9', '+', '-'] then
 begin
   neg := fCh = '-';
   if fCh in ['+', '-'] then
     get;
   value := 0;
   if fCh in ['0'..'9'] then
   begin
     while fCh in ['0'..'9'] do
     begin
       value := 10 * value + (ord(fCh) - ord('0'));
       get
     end;
     new(node);
     node^.typ := number;
     if (neg) then
       node^.value := -value
     else
       node^.value := value
   end
 end;
 if node = nil then
 begin
   new(node);
   node^.typ := error;
 end;
 parseValue := node

end;

function TASTParse.eval(ast: pAstNode): Integer; begin

 with ast^ do
   case typ of
     number:
       Result := value;
     binop:
       case operation of
         '+':
           Result := eval(first) + eval(second);
         '-':
           Result := eval(first) - eval(second);
         '*':
           Result := eval(first) * eval(second);
         '/':
           Result := eval(first) div eval(second);
       end;
     error:
       begin
         Result := 0;
         FEvalError := True;
       end;
   end

end;

constructor TASTParse.Create(Expression: string); begin

 Create;
 Parse(Expression);

end;

constructor TASTParse.Create; begin

 fCh := #0;
 FExpression := ;
 FResult := 0;
 fAst := nil;

end;

destructor TASTParse.Destroy; begin

 if Assigned(fAst) then
   disposeTree(fAst);
 inherited;

end;

procedure TASTParse.Get; begin

 if FExpression.isempty then
 begin
   fCh := #0;
   exit;
 end;
 fCh := FExpression.Substring(0, 1)[1];
 delete(FExpression, 1, 1);

end;

const

 EXP = '1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1';

begin

 with TASTParse.Create do
 begin
   writeln(EXP, ' = ', parse(EXP));
   Free;
 end;
 Readln;

end.</lang>

Output:

1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1 = 60