Arithmetic evaluation/Pascal

Works with: GNU Pascal version 20060325, based on gcc-3.4.4

Note: This code is completely standard pascal, checked with gpc --classic-pascal. It uses certain features of standard Pascal which are not implemented in all Pascal compilers (e.g. the code will not compile with Turbo/Borland Pascal or Free Pascal).

program calculator(input, output);

type
 NodeType = (binop, number, error);

 pAstNode = ^tAstNode;
 tAstNode = record
             case typ: NodeType of
              binop:
              (
                operation: char;
                first, second: pAstNode;
              );
              number:
               (value: integer);
              error:
               ();
            end;

function newBinOp(op: char; left: pAstNode): pAstNode;
 var
  node: pAstNode;
 begin
  new(node, binop);
  node^.operation := op;
  node^.first := left;
  node^.second := nil;
  newBinOp := node;
 end;

procedure 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 skipWhitespace(var f: text);
 var
  ch:char;
 function isWhite: boolean;
  begin
   isWhite := false;
   if not eoln(f)
    then
     if f^ = ' '
      then
       isWhite := true
  end;
 begin
  while isWhite do
   read(f, ch)
 end;

function parseAddSub(var f: text): pAstNode; forward;
function parseMulDiv(var f: text): pAstNode; forward;
function parseValue(var f: text): pAstNode; forward;

function parseAddSub;
 var
  node1, node2: pAstNode;
  continue: boolean;
 begin
  node1 := parseMulDiv(f);
  if node1^.typ <> error
   then
    begin
     continue := true;
     while continue and not eoln(f) do
      begin
       skipWhitespace(f);
       if f^ in ['+', '-']
        then
         begin
          node1 := newBinop(f^, node1);
          get(f);
          node2 := parseMulDiv(f);
          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 parseMulDiv;
 var
  node1, node2: pAstNode;
  continue: boolean;
 begin
  node1 := parseValue(f);
  if node1^.typ <> error
   then
    begin
     continue := true;
     while continue and not eoln(f) do
      begin
       skipWhitespace(f);
       if f^ in ['*', '/']
        then
         begin
          node1 := newBinop(f^, node1);
          get(f);
          node2 := parseValue(f);
          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 parseValue;
 var
  node:  pAstNode;
  value: integer;
  neg:   boolean;
 begin
  node := nil;
  skipWhitespace(f);
  if f^ = '('
   then
    begin
     get(f);
     node := parseAddSub(f);
     if node^.typ <> error
      then
       begin
        skipWhitespace(f);
        if f^ = ')'
         then
          get(f)
         else
          begin
           disposeTree(node);
           new(node, error)
          end
       end
    end
   else if f^ in ['0' .. '9', '+', '-']
    then
     begin
      neg := f^ = '-';
      if f^ in ['+', '-']
       then
        get(f);
      value := 0;
      if f^ in ['0' .. '9']
       then
        begin
         while f^ in ['0' .. '9'] do
          begin
           value := 10 * value + (ord(f^) - ord('0'));
           get(f)
          end;
         new(node, number);
         if (neg)
          then
           node^.value := -value
          else
           node^.value := value
        end
     end;
  if node = nil
   then
    new(node, error);
  parseValue := node
 end;

function eval(ast: pAstNode): integer;
 begin
  with ast^ do
   case typ of
    number: eval := value;
    binop:
     case operation of
      '+': eval := eval(first) + eval(second);
      '-': eval := eval(first) - eval(second);
      '*': eval := eval(first) * eval(second);
      '/': eval := eval(first) div eval(second);
     end;
    error:
     writeln('Oops! Program is buggy!')
   end
 end;

procedure ReadEvalPrintLoop;
 var
  ast: pAstNode;
 begin
  while not eof do
   begin
    ast := parseAddSub(input);
    if (ast^.typ = error) or not eoln
     then
      writeln('Error in expression.')
     else
      writeln('Result: ', eval(ast));
    readln;
    disposeTree(ast)
   end
 end;

begin
 ReadEvalPrintLoop
end.