Arithmetic evaluation/Pascal
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).
<lang 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.</lang>