Skip to content

Instantly share code, notes, and snippets.

@pakLebah
Last active Jan 12, 2020
Embed
What would you like to do?
Simple calculator program using custom math expression parsing.
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.
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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment