Simple calculator program using custom math expression parsing.

calc.pas

program Calc;

(******************************************************************************
  Program: calc.pas (Calculator)
  Author : paklebah.github.io
  Description:
    Calc calculates value from a simple aritmathical formula. The purpose of
    this program is to demonstrate a simple parsing algorithm to newbies.

  Version history:
  # v.0.1 (January 2020, Malang, Indonesia) by paklebah.
    * FEATURES:
      - Based on expression → term → factor parsing algorithm using simple
        procedural programming paradigm, instead of OOP.
      - Supports common math operators, constants, and parenthesis.
    * TODO:
      - unpaired parenthesis detection fails.
      - more proper error messages and handling.
      - more tests with various formula possibilities.
      - more math operators e.g. root, exponential, factorial.

  Last update: 12 January 2020
 ******************************************************************************)

{$MODE OBJFPC}{$J-}

type
  Tokens = (tUnknown, tBlank, tText, tNumber, tMinus,
            tPlus, tAsterisk, tSlash, tOpen, tClose);

var
  count, cursor: integer;  // length and position
  formula: string;         // the formula string
  isError: boolean;        // error parsing flag

{ define acceptable characters in formula }

function isWhiteSpace(c: char): boolean;
begin
  result := c in [' ', #9];  // space and tab
end;

function isOperator(c: char): boolean;
begin
  result := (pos(c, '+-*/()') > 0);  // basic math operators
end;

function isLetter(c: char): boolean;
begin
  result := lowerCase(c) in ['a'..'z'];
end;

function isDigit(c: char): boolean;
begin
  result := c in ['0'..'9','.'];
end;

function isEOT: boolean; inline;
begin
  result := (cursor = count);  // end-of-text
end;

{ read value of a character sequence in formula }

procedure removeBlank;
begin
  while isWhiteSpace(formula[cursor]) do
    if not isEOT then cursor += 1 else break;
end;

function readText: string;
begin
  result := '';
  while (isLetter(formula[cursor]) or isDigit(formula[cursor])) do
  begin
    result := result + formula[cursor];
    if not isEOT then cursor += 1 else break;
  end;
end;

function readNumber: string;
begin
  result := '';
  while isDigit(formula[cursor]) do
  begin
    result := result + formula[cursor];
    if not isEOT then cursor += 1 else break;
  end;
end;

{ identifying every part of the formula }

procedure nextToken; forward;

procedure showError(const errorText: string);
begin
  // only shows the first error
  if isError then exit;

  isError := true;
  write('ERROR: ',errorText);
end;

function tokenType: Tokens;
begin
  repeat
    case formula[cursor] of
      ' ', #9 : begin
                  removeBlank;
                  result := tBlank;
                end;
      'a'..'z': result := tText;
      '0'..'9': result := tNumber;
      '-'     : result := tMinus;
      '+'     : result := tPlus;
      '*'     : result := tAsterisk;
      '/'     : result := tSlash;
      '('     : result := tOpen;
      ')'     : result := tClose;
      else      result := tUnknown;
    end;
  // ignore every whitespace found
  until (result <> tBlank) or isEOT;

  if result = tUnknown then showError('Unknown value or operator!');
end;

function tokenValue: string;
begin
  case tokenType of
    tBlank    : result := ' ';
    tText     : result := readText;
    tNumber   : result := readNumber;
    tMinus    : result := '-';
    tPlus     : result := '+';
    tAsterisk : result := '*';
    tSlash    : result := '/';
    tOpen     : result := '(';
    tClose    : result := ')';
    tUnknown  : result := #255;
  end;
end;

procedure nextToken;
begin
  if not isEOT then
    cursor += 1
  else
  begin
    if not (tokenType in [tNumber, tText, tClose]) then
      showError('Wrong or incomplete formula!');
  end;
end;

{ evaluate every part of the formula }

function factor: double; forward;

// define value of known constants
function constant(const name: string): double;
begin
  result := 0.0;
  case lowerCase(name) of
    'pi': result := Pi;
  end;
end;

// multiplication and division operation
function term: double;
var
  value: double;
begin
  result := factor;
  repeat
    case tokenType of
      tAsterisk : begin
                    nextToken;
                    result := result * factor;
                  end;
      tSlash    : begin
                    nextToken;
                    value := factor;
                    if value = 0.0 then showError('Division by zero!')
                      else result := result / value;
                  end;
      else exit;
    end;
  until false;
end;

// sequence of term and factor (aka formula)
function expression: double;
begin
  result := term;
  repeat
    case tokenType of
      tPlus : begin
                nextToken;
                result := result + term;
              end;
      tMinus: begin
                nextToken;
                result := result - term;
              end;
      else exit;
    end;
  until false;
end;

// constant and unary operation
function factor: double;
var
  c: integer;
  value: string;
begin
  result := 0;
  case tokenType of
    tNumber : begin
                value := tokenValue;
                val(value, result, c);
                if c > 0 then
                  showError('"'+value+'" is invalid number!')
                else if not (isOperator(tokenValue[1]) or isEOT) then
                  showError('Expected operator not found!');
              end;
    tText   : begin
                value := tokenValue;
                result := constant(value);
                if result = 0.0 then  // constant can't be zero
                  showError('Unknown constant "'+value+'"!');
              end;
    tPlus   : begin
                nextToken;
                result := +factor();  // recursive
              end;
    tMinus  : begin
                nextToken;
                result := -factor();  // recursive
              end;
    tOpen   : begin
                nextToken;
                result := expression;
                if tokenType <> tClose then
                  showError('Close parenthesis not found!')
                else
                  nextToken;
              end;
    else
      showError('Wrong or incomplete formula!');
  end;
end;

// calculate the value of an expression
function calculate: double;
begin
  result := expression;
end;

(***** main program – demo and test *****)

const
  PASSED: string = #27'[32m'+'PASSED'+#27'[39m';
  FAILED: string = #27'[91m'+'FAILED'+#27'[39m';
  WIDTH = 5; FRACT = 2;  // floating precision

var
  i: integer = 1;
  return: double = 0.0;

// floating point equality checking
function isEqual(aValue, compareTo: double): boolean;
var
  value, compare: string;
begin
  str(aValue:WIDTH:FRACT, value);
  str(compareTo:WIDTH:FRACT, compare);
  result := (value = compare);
end;

// execute formula calculator main function
procedure execute(const text: string);
begin
  formula := text;
  cursor  := 1;
  count   := length(formula);
  isError := false;
  write(i:2,'. ',formula,' = ');

  return := calculate;
  if not isError then write(return:WIDTH:FRACT);
  inc(i);
end;

// test error result
function test(const text: string; const error: boolean): boolean;
begin
  execute(text);
  result := (isError = error);
  if result then writeln(' → ',PASSED) else write(' → ',FAILED);
  if not result then writeln(' (should be ERROR)');
end;

// test value result
function test(const text: string; const value: double): boolean;
begin
  execute(text);
  result := isEqual(return, value);
  if result then writeln(' → ',PASSED) else write(' → ',FAILED);
  if not result then writeln(' (should be ',value:WIDTH:FRACT,')');
end;

{ MAIN PROGRAM }
begin
  test('6+3',6+3);
  test('6-3',6-3);
  test('6*3',6*3);
  test('6/3',6/3);
  test('pi*pi',false);
  test('6.3.2',true);
  test('6+3*2',6+3*2);
  test('6-3/3',6-3/3);
  test('6*3+2',6*3+2);
  test('6/3-3',6/3-3);
  test('(6+3)*2',(6+3)*2);
  test('6-(3/3)',6-(3/3));
  test('(6*3)+2',(6*3)+2);
  test('6/(3-1)',6/(3-1));
  test('6*pi/(3-1)',6*pi/(3-1));
  test('6/ro*(3-1)',true);
  test('6/(3*0)+5',true);
  test('6*/3-3)*',true);
  test('6?3-3)*',true);
  test('6/(3-3 ',true);
  test('6/3-3)5',true);
  test('63 - 35',63-35);
  test(' 63-35 ',63-35);
  test('6 3- 35',true);
  test('6a3- 35',true);
  test('4+6-4/2*3',4+6-4/2*3);
  test('4+(6-4/2)*3',4+(6-4/2)*3);
  test('4+(6-4)/(2*2)',4+(6-4)/(2*2));
  test('(4+6)-4/(2*2)',(4+6)-4/(2*2));
  test('4+(6-4/(2*2)',true);
  test('4+(6-4)/2*2)',true);
end.

test.txt

 1. 6+3 =  9.00 → PASSED
 2. 6-3 =  3.00 → PASSED
 3. 6*3 = 18.00 → PASSED
 4. 6/3 =  2.00 → PASSED
 5. pi*pi =  9.87 → PASSED
 6. 6.3.2 = ERROR: "6.3.2" is invalid number! → PASSED
 7. 6+3*2 = 12.00 → PASSED
 8. 6-3/3 =  5.00 → PASSED
 9. 6*3+2 = 20.00 → PASSED
10. 6/3-3 = -1.00 → PASSED
11. (6+3)*2 = 18.00 → PASSED
12. 6-(3/3) =  5.00 → PASSED
13. (6*3)+2 = 20.00 → PASSED
14. 6/(3-1) =  3.00 → PASSED
15. 6*pi/(3-1) =  9.42 → PASSED
16. 6/ro*(3-1) = ERROR: Unknown constant "ro"! → PASSED
17. 6/(3*0)+5 = ERROR: Division by zero! → PASSED
18. 6*/3-3)* = ERROR: Wrong or incomplete formula! → PASSED
19. 6?3-3)* = ERROR: Unknown value or operator! → PASSED
20. 6/(3-3  = ERROR: Close parenthesis not found! → PASSED
21. 6/3-3)5 = -1.00 → FAILED (should be ERROR)
22. 63 - 35 = 28.00 → PASSED
23.  63-35  = 28.00 → PASSED
24. 6 3- 35 = ERROR: Expected operator not found! → PASSED
25. 6a3- 35 = ERROR: Expected operator not found! → PASSED
26. 4+6-4/2*3 =  4.00 → PASSED
27. 4+(6-4/2)*3 = 16.00 → PASSED
28. 4+(6-4)/(2*2) =  4.50 → PASSED
29. (4+6)-4/(2*2) =  9.00 → PASSED
30. 4+(6-4/(2*2) =  9.00 → FAILED (should be ERROR)
31. 4+(6-4)/2*2) =  6.00 → FAILED (should be ERROR)