WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Source/SCAN.ob07

 (*
     BSD 2-Clause License
-    Copyright (c) 2018-2019, Anton Krotov
+    Copyright (c) 2018-2020, Anton Krotov
     All rights reserved.
 *)
 MODULE SCAN;
-IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS;
+IMPORT TXT := TEXTDRV, AVL := AVLTREES, ARITH, S := STRINGS, ERRORS, LISTS;
 CONST
     LEXLEN = 1024;
     lxUNDEF*   =  0;  lxIDENT*   =  1;  lxINTEGER*   =  2;  lxHEX*     =  3;
     lxCHAR*    =  4;  lxFLOAT*   =  5;  lxSTRING*    =  6;  lxCOMMENT* =  7;
     lxEOF*     =  8;
     lxPLUS*    = 21;  lxMINUS*   = 22;  lxMUL*       = 23;  lxSLASH*   = 24;
     lxNOT*     = 25;  lxAND*     = 26;  lxPOINT*     = 27;  lxCOMMA*   = 28;
     lxSEMI*    = 29;  lxBAR*     = 30;  lxLROUND*    = 31;  lxLSQUARE* = 32;
     lxLCURLY*  = 33;  lxCARET*   = 34;  lxEQ*        = 35;  lxNE*      = 36;
     lxLT*      = 37;  lxGT*      = 38;  lxCOLON*     = 39;  lxRROUND*  = 40;
     lxRSQUARE* = 41;  lxRCURLY*  = 42;  lxLE*        = 43;  lxGE*      = 44;
     lxASSIGN*  = 45;  lxRANGE*   = 46;
     lxKW       = 51;
     lxARRAY*   = 51;  lxBEGIN*   = 52;  lxBY*        = 53;  lxCASE*    = 54;
     lxCONST*   = 55;  lxDIV*     = 56;  lxDO*        = 57;  lxELSE*    = 58;
     lxELSIF*   = 59;  lxEND*     = 60;  lxFALSE*     = 61;  lxFOR*     = 62;
     lxIF*      = 63;  lxIMPORT*  = 64;  lxIN*        = 65;  lxIS*      = 66;
     lxMOD*     = 67;  lxMODULE*  = 68;  lxNIL*       = 69;  lxOF*      = 70;
     lxOR*      = 71;  lxPOINTER* = 72;  lxPROCEDURE* = 73;  lxRECORD*  = 74;
     lxREPEAT*  = 75;  lxRETURN*  = 76;  lxTHEN*      = 77;  lxTO*      = 78;
     lxTRUE*    = 79;  lxTYPE*    = 80;  lxUNTIL*     = 81;  lxVAR*     = 82;
     lxWHILE*   = 83;
     lxERROR01* =  -1;  lxERROR02* =  -2;  lxERROR03* =  -3;  lxERROR04* =  -4;
     lxERROR05* =  -5;  lxERROR06* =  -6;  lxERROR07* =  -7;  lxERROR08* =  -8;
     lxERROR09* =  -9;  lxERROR10* = -10;  lxERROR11* = -11;  lxERROR12* = -12;
     lxERROR13* = -13;
 TYPE
     LEXSTR* = ARRAY LEXLEN OF CHAR;
+    DEF = POINTER TO RECORD (LISTS.ITEM)
+        ident: LEXSTR
+    END;
     IDENT* = POINTER TO RECORD (AVL.DATA)
         s*: LEXSTR;
         offset*, offsetW*: INTEGER;
         key: INTEGER
     END;
     POSITION* = RECORD
         line*, col*: INTEGER
     END;
     LEX* = RECORD
         s*:         LEXSTR;
         length*:    INTEGER;
         sym*:       INTEGER;
         pos*:       POSITION;
         ident*:     IDENT;
         string*:    IDENT;
         value*:     ARITH.VALUE;
         error*:     INTEGER;
         over:       BOOLEAN
     END;
     SCANNER* = TXT.TEXT;
 VAR
     idents: AVL.NODE;
     delimiters: ARRAY 256 OF BOOLEAN;
     NewIdent: IDENT;
+    upto, LowerCase, _if: BOOLEAN;
-    upto: BOOLEAN;
+    def: LISTS.LIST;
 PROCEDURE nodecmp (a, b: AVL.DATA): INTEGER;
     RETURN ORD(a(IDENT).s > b(IDENT).s) - ORD(a(IDENT).s < b(IDENT).s)
 END nodecmp;
 PROCEDURE enterid* (s: LEXSTR): IDENT;
 VAR
     newnode: BOOLEAN;
     node:    AVL.NODE;
 BEGIN
     NewIdent.s := s;
     idents := AVL.insert(idents, NewIdent, nodecmp, newnode, node);
     IF newnode THEN
         NEW(NewIdent);
         NewIdent.offset  := -1;
         NewIdent.offsetW := -1;
         NewIdent.key := 0
     END
     RETURN node.data(IDENT)
 END enterid;
 PROCEDURE putchar (VAR lex: LEX; c: CHAR);
 BEGIN
     IF lex.length < LEXLEN - 1 THEN
         lex.s[lex.length] := c;
         INC(lex.length);
         lex.s[lex.length] := 0X
     ELSE
         lex.over := TRUE
     END
 END putchar;
 PROCEDURE nextc (text: TXT.TEXT): CHAR;
 BEGIN
     TXT.next(text)
     RETURN text.peak
 END nextc;
 PROCEDURE ident (text: TXT.TEXT; VAR lex: LEX);
 VAR
     c: CHAR;
 BEGIN
     c := text.peak;
     ASSERT(S.letter(c));
     WHILE S.letter(c) OR S.digit(c) DO
         putchar(lex, c);
         c := nextc(text)
     END;
     IF lex.over THEN
         lex.sym := lxERROR06
     ELSE
         lex.ident := enterid(lex.s);
         IF lex.ident.key # 0 THEN
             lex.sym := lex.ident.key
         ELSE
             lex.sym := lxIDENT
         END
     END
 END ident;
 PROCEDURE number (text: TXT.TEXT; VAR lex: LEX);
 VAR
     c: CHAR;
     hex: BOOLEAN;
-    error: INTEGER;
+    error, sym: INTEGER;
 BEGIN
     c := text.peak;
     ASSERT(S.digit(c));
     error := 0;
-    lex.sym := lxINTEGER;
+    sym := lxINTEGER;
     hex := FALSE;
     WHILE S.digit(c) DO
         putchar(lex, c);
         c := nextc(text)
     END;
     WHILE S.hexdigit(c) DO
         putchar(lex, c);
         c := nextc(text);
         hex := TRUE
     END;
     IF c = "H" THEN
         putchar(lex, c);
         TXT.next(text);
-        lex.sym := lxHEX
+        sym := lxHEX
     ELSIF c = "X" THEN
         putchar(lex, c);
         TXT.next(text);
-        lex.sym := lxCHAR
+        sym := lxCHAR
     ELSIF c = "." THEN
         IF hex THEN
-            lex.sym := lxERROR01
+            sym := lxERROR01
         ELSE
             c := nextc(text);
             IF c # "." THEN
                 putchar(lex, ".");
-                lex.sym := lxFLOAT
+                sym := lxFLOAT
             ELSE
-                lex.sym := lxINTEGER;
+                sym := lxINTEGER;
                 text.peak := 7FX;
                 upto := TRUE
             END;
             WHILE S.digit(c) DO
                 putchar(lex, c);
                 c := nextc(text)
             END;
             IF c = "E" THEN
                 putchar(lex, c);
                 c := nextc(text);
                 IF (c = "+") OR (c = "-") THEN
                     putchar(lex, c);
                     c := nextc(text)
                 END;
                 IF S.digit(c) THEN
                     WHILE S.digit(c) DO
                         putchar(lex, c);
                         c := nextc(text)
                     END
                 ELSE
-                    lex.sym := lxERROR02
+                    sym := lxERROR02
                 END
             END
         END
     ELSIF hex THEN
-        lex.sym := lxERROR01
+        sym := lxERROR01
     END;
-    IF lex.over & (lex.sym >= 0) THEN
+    IF lex.over & (sym >= 0) THEN
-        lex.sym := lxERROR07
+        sym := lxERROR07
     END;
-    IF lex.sym = lxINTEGER THEN
+    IF sym = lxINTEGER THEN
         ARITH.iconv(lex.s, lex.value, error)
-    ELSIF (lex.sym = lxHEX) OR (lex.sym = lxCHAR) THEN
+    ELSIF (sym = lxHEX) OR (sym = lxCHAR) THEN
         ARITH.hconv(lex.s, lex.value, error)
-    ELSIF lex.sym = lxFLOAT THEN
+    ELSIF sym = lxFLOAT THEN
         ARITH.fconv(lex.s, lex.value, error)
     END;
     CASE error OF
     |0:
-    |1: lex.sym := lxERROR08
+    |1: sym := lxERROR08
-    |2: lex.sym := lxERROR09
+    |2: sym := lxERROR09
-    |3: lex.sym := lxERROR10
+    |3: sym := lxERROR10
-    |4: lex.sym := lxERROR11
+    |4: sym := lxERROR11
-    |5: lex.sym := lxERROR12
+    |5: sym := lxERROR12
-    END
+    END;
     lex.sym := sym
 END number;
 PROCEDURE string (text: TXT.TEXT; VAR lex: LEX; quot: CHAR);
 VAR
     c: CHAR;
     n: INTEGER;
 BEGIN
     c  := nextc(text);
     n  := 0;
     WHILE (c # quot) & (c # 0X) & ~text.eol & ~text.eof DO
         putchar(lex, c);
         c := nextc(text);
         INC(n)
     END;
     IF c = quot THEN
         TXT.next(text);
         IF lex.over THEN
             lex.sym := lxERROR05
         ELSE
             IF n # 1 THEN
                 lex.sym := lxSTRING
             ELSE
                 lex.sym := lxCHAR;
                 ARITH.setChar(lex.value, ORD(lex.s[0]))
             END
         END
     ELSE
         lex.sym := lxERROR03
     END;
     IF lex.sym = lxSTRING THEN
         lex.string := enterid(lex.s);
         lex.value.typ := ARITH.tSTRING;
         lex.value.string := lex.string
     END
 END string;
 PROCEDURE comment (text: TXT.TEXT);
 VAR
     c: CHAR;
     cond, depth: INTEGER;
 BEGIN
     cond  := 0;
     depth := 1;
     REPEAT
         c := text.peak;
         TXT.next(text);
         IF c = "*" THEN
             IF cond = 1 THEN
                 cond := 0;
                 INC(depth)
             ELSE
                cond := 2
             END
         ELSIF c = ")" THEN
             IF cond = 2 THEN
                 DEC(depth)
             END;
             cond := 0
         ELSIF c = "(" THEN
             cond := 1
         ELSE
             cond := 0
         END
     UNTIL (depth = 0) OR text.eof
 END comment;
 PROCEDURE delimiter (text: TXT.TEXT; VAR lex: LEX; c: CHAR);
+VAR
+    sym: INTEGER;
 BEGIN
     putchar(lex, c);
     c := nextc(text);
     CASE lex.s[0] OF
     |"+":
-        lex.sym := lxPLUS
+        sym := lxPLUS
     |"-":
-        lex.sym := lxMINUS
+        sym := lxMINUS
     |"*":
-        lex.sym := lxMUL
+        sym := lxMUL
     |"/":
-        lex.sym := lxSLASH;
+        sym := lxSLASH;
         IF c = "/" THEN
-            lex.sym := lxCOMMENT;
+            sym := lxCOMMENT;
             REPEAT
                 TXT.next(text)
             UNTIL text.eol OR text.eof
         END
     |"~":
-        lex.sym := lxNOT
+        sym := lxNOT
     |"&":
-        lex.sym := lxAND
+        sym := lxAND
     |".":
-        lex.sym := lxPOINT;
+        sym := lxPOINT;
         IF c = "." THEN
-            lex.sym := lxRANGE;
+            sym := lxRANGE;
             putchar(lex, c);
             TXT.next(text)
         END
     |",":
-        lex.sym := lxCOMMA
+        sym := lxCOMMA
     |";":
-        lex.sym := lxSEMI
+        sym := lxSEMI
     |"|":
-        lex.sym := lxBAR
+        sym := lxBAR
     |"(":
-        lex.sym := lxLROUND;
+        sym := lxLROUND;
         IF c = "*" THEN
-            lex.sym := lxCOMMENT;
+            sym := lxCOMMENT;
             TXT.next(text);
             comment(text)
         END
     |"[":
-        lex.sym := lxLSQUARE
+        sym := lxLSQUARE
     |"{":
-        lex.sym := lxLCURLY
+        sym := lxLCURLY
     |"^":
-        lex.sym := lxCARET
+        sym := lxCARET
     |"=":
-        lex.sym := lxEQ
+        sym := lxEQ
     |"#":
-        lex.sym := lxNE
+        sym := lxNE
     |"<":
-        lex.sym := lxLT;
+        sym := lxLT;
         IF c = "=" THEN
-            lex.sym := lxLE;
+            sym := lxLE;
             putchar(lex, c);
             TXT.next(text)
         END
     |">":
-        lex.sym := lxGT;
+        sym := lxGT;
         IF c = "=" THEN
-            lex.sym := lxGE;
+            sym := lxGE;
             putchar(lex, c);
             TXT.next(text)
         END
     |":":
-        lex.sym := lxCOLON;
+        sym := lxCOLON;
         IF c = "=" THEN
-            lex.sym := lxASSIGN;
+            sym := lxASSIGN;
             putchar(lex, c);
             TXT.next(text)
         END
     |")":
-        lex.sym := lxRROUND
+        sym := lxRROUND
     |"]":
-        lex.sym := lxRSQUARE
+        sym := lxRSQUARE
     |"}":
+        sym := lxRCURLY
-        lex.sym := lxRCURLY
+    END;
-    END
+    lex.sym := sym
 END delimiter;
 PROCEDURE Next* (text: SCANNER; VAR lex: LEX);
 VAR
     c: CHAR;
+    PROCEDURE check (cond: BOOLEAN; text: SCANNER; lex: LEX; errno: INTEGER);
+    BEGIN
+        IF ~cond THEN
+            ERRORS.ErrorMsg(text.fname, lex.pos.line, lex.pos.col, errno)
+        END
+    END check;
+    PROCEDURE IsDef (str: ARRAY OF CHAR): BOOLEAN;
+    VAR
+        cur: DEF;
+    BEGIN
+        cur := def.first(DEF);
+        WHILE (cur # NIL) & (cur.ident # str) DO
+            cur := cur.next(DEF)
+        END
+        RETURN cur # NIL
+    END IsDef;
+    PROCEDURE Skip (text: SCANNER);
+    VAR
+        i: INTEGER;
+    BEGIN
+        i := 0;
+        WHILE (i <= text.ifc) & ~text._skip[i] DO
+            INC(i)
+        END;
+        text.skip := i <= text.ifc
+    END Skip;
+    PROCEDURE prep_if (text: SCANNER; VAR lex: LEX);
+    VAR
+        skip: BOOLEAN;
+    BEGIN
+        INC(text.ifc);
+        text._elsif[text.ifc] := lex.sym = lxELSIF;
+        IF lex.sym = lxIF THEN
+            INC(text.elsec);
+            text._else[text.elsec] := FALSE
+        END;
+        _if := TRUE;
+        skip := TRUE;
+        text.skip := FALSE;
+        Next(text, lex);
+        check(lex.sym = lxLROUND, text, lex, 64);
+        Next(text, lex);
+        check(lex.sym = lxIDENT, text, lex, 22);
+        REPEAT
+            IF IsDef(lex.s) THEN
+                skip := FALSE
+            END;
+            Next(text, lex);
+            IF lex.sym = lxBAR THEN
+                Next(text, lex);
+                check(lex.sym = lxIDENT, text, lex, 22)
+            ELSE
+                check(lex.sym = lxRROUND, text, lex, 33)
+            END
+        UNTIL lex.sym = lxRROUND;
+        _if := FALSE;
+        text._skip[text.ifc] := skip;
+        Skip(text);
+        Next(text, lex)
+    END prep_if;
+    PROCEDURE prep_end (text: SCANNER; VAR lex: LEX);
+    BEGIN
+        check(text.ifc > 0, text, lex, 118);
+        IF lex.sym = lxEND THEN
+            WHILE text._elsif[text.ifc] DO
+                DEC(text.ifc)
+            END;
+            DEC(text.ifc);
+            DEC(text.elsec)
+        ELSIF (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
+            check(~text._else[text.elsec], text, lex, 118);
+            text._skip[text.ifc] := ~text._skip[text.ifc];
+            text._else[text.elsec] := lex.sym = lxELSE
+        END;
+        Skip(text);
+        IF lex.sym = lxELSIF THEN
+            prep_if(text, lex)
+        ELSE
+            Next(text, lex)
+        END
+    END prep_end;
 BEGIN
     REPEAT
         c := text.peak;
         WHILE S.space(c) DO
             c := nextc(text)
         END;
         lex.s[0]     := 0X;
         lex.length   := 0;
         lex.pos.line := text.line;
         lex.pos.col  := text.col;
         lex.ident    := NIL;
         lex.over     := FALSE;
         IF S.letter(c) THEN
             ident(text, lex)
         ELSIF S.digit(c) THEN
             number(text, lex)
         ELSIF (c = '"') OR (c = "'") THEN
             string(text, lex, c)
         ELSIF delimiters[ORD(c)] THEN
             delimiter(text, lex, c)
+        ELSIF c = "$" THEN
+            IF S.letter(nextc(text)) THEN
+                ident(text, lex);
+                IF lex.sym = lxIF THEN
+                    IF ~_if THEN
+                        prep_if(text, lex)
+                    END
+                ELSIF (lex.sym = lxEND) OR (lex.sym = lxELSE) OR (lex.sym = lxELSIF) THEN
+                    IF ~_if THEN
+                        prep_end(text, lex)
+                    END
+                ELSE
+                    check(FALSE, text, lex, 119)
+                END
+            ELSE
+                check(FALSE, text, lex, 119)
+            END
         ELSIF c = 0X THEN
             lex.sym := lxEOF;
+            text.skip := FALSE;
             IF text.eof THEN
                 INC(lex.pos.col)
             END
         ELSIF (c = 7FX) & upto THEN
             upto := FALSE;
             lex.sym := lxRANGE;
             putchar(lex, ".");
             putchar(lex, ".");
             DEC(lex.pos.col);
             TXT.next(text)
         ELSE
             putchar(lex, c);
             TXT.next(text);
             lex.sym := lxERROR04
         END;
         IF lex.sym < 0 THEN
             lex.error := -lex.sym
         ELSE
             lex.error := 0
         END
-    UNTIL lex.sym # lxCOMMENT
+    UNTIL (lex.sym # lxCOMMENT) & ~text.skip
 END Next;
 PROCEDURE open* (name: ARRAY OF CHAR): SCANNER;
     RETURN TXT.open(name)
 END open;
 PROCEDURE close* (VAR scanner: SCANNER);
 BEGIN
     TXT.close(scanner)
 END close;
-PROCEDURE init;
+PROCEDURE init* (lower: BOOLEAN);
 VAR
     i: INTEGER;
     delim: ARRAY 23 OF CHAR;
     PROCEDURE enterkw (key: INTEGER; kw: LEXSTR);
     VAR
         id: IDENT;
+        upper: LEXSTR;
+    BEGIN
-    BEGIN
+        IF LowerCase THEN
-        id := enterid(kw);
+            id := enterid(kw);
+            id.key := key
+        END;
+        upper := kw;
+        S.UpCase(upper);
+        id := enterid(upper);
         id.key := key
     END enterkw;
 BEGIN
     upto := FALSE;
+    LowerCase := lower;
     FOR i := 0 TO 255 DO
         delimiters[i] := FALSE
     END;
     delim := "+-*/~&.,;|([{^=#<>:)]}";
     FOR i := 0 TO LEN(delim) - 2 DO
         delimiters[ORD(delim[i])] := TRUE
     END;
     NEW(NewIdent);
     NewIdent.s       := "";
     NewIdent.offset  := -1;
     NewIdent.offsetW := -1;
     NewIdent.key     := 0;
     idents := NIL;
-    enterkw(lxARRAY, "ARRAY");
+    enterkw(lxARRAY, "array");
-    enterkw(lxBEGIN, "BEGIN");
+    enterkw(lxBEGIN, "begin");
-    enterkw(lxBY, "BY");
+    enterkw(lxBY, "by");
-    enterkw(lxCASE, "CASE");
+    enterkw(lxCASE, "case");
-    enterkw(lxCONST, "CONST");
+    enterkw(lxCONST, "const");
-    enterkw(lxDIV, "DIV");
+    enterkw(lxDIV, "div");
-    enterkw(lxDO, "DO");
+    enterkw(lxDO, "do");
-    enterkw(lxELSE, "ELSE");
+    enterkw(lxELSE, "else");
-    enterkw(lxELSIF, "ELSIF");
+    enterkw(lxELSIF, "elsif");
-    enterkw(lxEND, "END");
+    enterkw(lxEND, "end");
-    enterkw(lxFALSE, "FALSE");
+    enterkw(lxFALSE, "false");
-    enterkw(lxFOR, "FOR");
+    enterkw(lxFOR, "for");
-    enterkw(lxIF, "IF");
+    enterkw(lxIF, "if");
-    enterkw(lxIMPORT, "IMPORT");
+    enterkw(lxIMPORT, "import");
-    enterkw(lxIN, "IN");
+    enterkw(lxIN, "in");
-    enterkw(lxIS, "IS");
+    enterkw(lxIS, "is");
-    enterkw(lxMOD, "MOD");
+    enterkw(lxMOD, "mod");
-    enterkw(lxMODULE, "MODULE");
+    enterkw(lxMODULE, "module");
-    enterkw(lxNIL, "NIL");
+    enterkw(lxNIL, "nil");
-    enterkw(lxOF, "OF");
+    enterkw(lxOF, "of");
-    enterkw(lxOR, "OR");
+    enterkw(lxOR, "or");
-    enterkw(lxPOINTER, "POINTER");
+    enterkw(lxPOINTER, "pointer");
-    enterkw(lxPROCEDURE, "PROCEDURE");
+    enterkw(lxPROCEDURE, "procedure");
-    enterkw(lxRECORD, "RECORD");
+    enterkw(lxRECORD, "record");
-    enterkw(lxREPEAT, "REPEAT");
+    enterkw(lxREPEAT, "repeat");
-    enterkw(lxRETURN, "RETURN");
+    enterkw(lxRETURN, "return");
-    enterkw(lxTHEN, "THEN");
+    enterkw(lxTHEN, "then");
-    enterkw(lxTO, "TO");
+    enterkw(lxTO, "to");
-    enterkw(lxTRUE, "TRUE");
+    enterkw(lxTRUE, "true");
-    enterkw(lxTYPE, "TYPE");
+    enterkw(lxTYPE, "type");
-    enterkw(lxUNTIL, "UNTIL");
+    enterkw(lxUNTIL, "until");
-    enterkw(lxVAR, "VAR");
+    enterkw(lxVAR, "var");
-    enterkw(lxWHILE, "WHILE")
+    enterkw(lxWHILE, "while")
 END init;
+PROCEDURE NewDef* (str: ARRAY OF CHAR);
+VAR
+    item: DEF;
+BEGIN
+    NEW(item);
+    COPY(str, item.ident);
+    LISTS.push(def, item)
+END NewDef;
 BEGIN
-    init
+    def := LISTS.create(NIL)
 END SCAN.
+>

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Source/SCAN.ob07 – Rev 7983 → 8097