⚠️ 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.