{ This program determines whether or not a string of parentheses input from the user is balanced. It uses the following recursive definition for nonempty balanced parenthesis strings: A balanced_string is either ( ), or a balanced_string_sequence between ( and ). A balanced_string_sequence is a sequence of one or more balanced_strings. The procedure Check recognizes balanced_strings, and the procedure CheckParenSeq recognizes balanced_string_sequences. } program parentest (input, output); type StringType = array [1..40] of char; var parens: StringType; index: integer; okSoFar: boolean; procedure CheckParenSeq (var parens: StringType; var index: integer; var okSoFar: boolean); forward; { Check is entered with index pointing to a left parenthesis, and updates index so that it points to the matching right parenthesis. Example: if parens contains (()()()) and Check is entered with index at 2, a value of 3 will be returned in index. The variable okSoFar indicates whether or not the string is legal. } procedure Check (var parens: StringType; var index: integer; var okSoFar: boolean); begin assert (parens[index] = '('); okSoFar := true; index := index + 1; while okSoFar and (parens[index] = '(') do begin CheckParenSeq (parens, index, okSoFar); end; if parens[index] <> ')' then begin okSoFar := false; end; end; { CheckParenSeq is entered with index pointing to a left parenthesis, and updates index so that it points one past the right parenthesis of the last balanced string in the sequence. Example: if parens contains (()()()) and CheckParenSeq is entered with index at 2, a value of 8 will be returned in index. The variable okSoFar indicates the legality of the string. } procedure CheckParenSeq {var parens: StringType; var index: integer; var okSoFar: boolean}; begin assert (parens[index] = '('); okSoFar := true; repeat Check (parens, index, okSoFar); if okSoFar then begin index := index + 1; end; until not okSoFar or (parens[index] <> '('); end; { Read a string (terminated by carriage return). We omit error checks to present the recursion more clearly. } procedure GetString (var s: StringType); var length: integer; begin length := 0; s := ' '; while not eoln (input) do begin length := length + 1; read (input, s[length]); end; readln (input); end; begin while true do begin write (output, 'Please type a paren string: '); GetString (parens); index := 1; okSoFar := true; CheckParenSeq (parens, index, okSoFar); if okSoFar and (parens[index] <> ')') then begin writeln (output, 'Balanced.'); end else begin writeln (output, 'Unbalanced at position ', index:1, '.'); end; end; end.