⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

{{works with|GNU Pascal|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.