View source for 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>
{{out}}
<pre>1 + 2*(3 - 2*(3 - 2)*((2 - 4)*5 - 22/(7 + 2*(3 - 1)) - 1)) + 1 = 60</pre>