OberonCore

PROGRAM Kur0510;

   CONST
      (* Kody tokenov dlja otkryvajuschih skobok *)
      bracket1 = 1; (* (<<(<< *)
      bracket2 = 2; (* (<< < << *)
      bracket3 = 3; (* (<<[<< *)
         (* Dlya zakryvajuschih beretsya so znakom - *)
      other = 4;
      eof = 0;

      br1open = '(<<(<<';
      br1close = '>>)>>)';
      br2open = '(<< < <<';
      br2close = '>> > >>)';
      br3open = '(<<[<<';
      br3close = '>>]>>)';

   TYPE
      Token = INTEGER;

   VAR
      input: STRING;
      ipos: INTEGER;

      curToken: Token;

      stack: ARRAY [0..1024] OF Token;
      spos: INTEGER;

   PROCEDURE ScanToken; FORWARD;

   FUNCTION ProcessInput: BOOLEAN;
      VAR ok: BOOLEAN;
   BEGIN
      ok := TRUE;
      spos := 0;
      ScanToken;
      WHILE (curToken <> eof) AND ok DO BEGIN
         CASE curToken OF
         bracket1, bracket2, bracket3:
            BEGIN
               stack[spos] := curToken;
               INC(spos)
            END;
         -bracket1, -bracket2, -bracket3:
            BEGIN
               IF (spos > 0) AND (stack[spos-1] = -curToken) THEN BEGIN
                  DEC(spos)
               END
               ELSE BEGIN
                  ok := FALSE
               END
            END
         END;
         ScanToken
      END;
      ok := ok AND (spos = 0);
      ProcessInput := ok
   END (* ProcessInput *);

   PROCEDURE CheckBracket (VAR isBracket: BOOLEAN; VAR brToken: Token;
      VAR len: INTEGER); FORWARD;

   PROCEDURE ScanToken;
      VAR isBracket: BOOLEAN;
            brToken: Token;
            brLen: INTEGER;
   BEGIN
      IF ipos <= LENGTH(input) THEN BEGIN
         CheckBracket(isBracket, brToken, brLen);
         IF isBracket THEN BEGIN
            curToken := brToken;
            INC(ipos, brLen)
         END
         ELSE BEGIN
            curToken := other;
            INC(ipos)
         END
      END
      ELSE BEGIN
         curToken := eof
      END
   END (* ScanToken *);

   FUNCTION Look (lexem: STRING): BOOLEAN;
      VAR i, j: INTEGER;
   BEGIN
      IF ipos + LENGTH(lexem)-1 <= LENGTH(input) THEN BEGIN
         i := ipos; j := 1;
         WHILE (j <= LENGTH(lexem)) AND (input[i] = lexem[j])
         DO BEGIN
            INC(i); INC(j)
         END;
         Look := j = LENGTH(lexem) + 1   (* To est, vse simvoly sovpali *)
      END
      ELSE BEGIN
         Look := FALSE
      END
   END (* Look *);

   PROCEDURE CheckBracket (VAR isBracket: BOOLEAN; VAR brToken: Token;
      VAR len: INTEGER);
   BEGIN
      IF Look(br1open) THEN BEGIN
         isBracket := TRUE;
         brToken := bracket1;
         len := LENGTH(br1open)
      END
      ELSE IF Look(br1close) THEN BEGIN
         isBracket := TRUE;
         brToken := -bracket1;
         len := LENGTH(br1close)
      END
      ELSE IF Look(br2open) THEN BEGIN
         isBracket := TRUE;
         brToken := bracket2;
         len := LENGTH(br2open)
      END
      ELSE IF Look(br2close) THEN BEGIN
         isBracket := TRUE;
         brToken := -bracket2;
         len := LENGTH(br2close)
      END
      ELSE IF Look(br3open) THEN BEGIN
         isBracket := TRUE;
         brToken := bracket3;
         len := LENGTH(br3open)
      END
      ELSE IF Look(br3close) THEN BEGIN
         isBracket := TRUE;
         brToken := -bracket3;
         len := LENGTH(br3close)
      END
      ELSE BEGIN
         isBracket := FALSE
      END
   END (* CheckBracket *);

BEGIN
   Write('Input string: ');
   ReadLn(input);
   ipos := 1;
   IF ProcessInput THEN BEGIN
      WriteLn('ok')
   END
   ELSE BEGIN
      WriteLn('Error!')
   END;
   WriteLn('Press Enter...');
   ReadLn
END.