Arithmetic evaluation: Difference between revisions
Content added Content deleted
(→{{header|Ada}}: Link to separate example page) |
(→{{header|Pascal}}: Link to separate example page) |
||
Line 964: | Line 964: | ||
=={{header|Pascal}}== |
=={{header|Pascal}}== |
||
See [[Arithmetic Evaluator/Pascal]]. |
|||
{{works with|GNU Pascal|20060325, based on gcc-3.4.4}} |
|||
Note: This code is completely standard pascal, checked with <tt>gpc --classic-pascal</tt>. 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> |
|||
=={{header|Perl}}== |
=={{header|Perl}}== |