tools/Coco/CRS.obn

   1 (*  scanner module generated by Coco-R *)
   2 MODULE CRS;
   3
   4 IMPORT Texts, SYSTEM;
   5
   6 CONST
   7         EOL = 0DX;
   8         EOF = 0X;
   9         maxLexLen = 127;
  10   noSym = 38;
  11
  12 TYPE
  13         ErrorProc* = PROCEDURE (n: INTEGER; pos: LONGINT);
  14         StartTable = ARRAY 128 OF INTEGER;
  15
  16 VAR
  17         src*: Texts.Text;  (*source text. To be set by the main pgm*)
  18         pos*: LONGINT;  (*position of current symbol*)
  19         line*, col*, len*: INTEGER;  (*line, column, length of current symbol*)
  20         nextPos*: LONGINT;  (*position of lookahead symbol*)
  21         nextLine*, nextCol*, nextLen*: INTEGER;  (*line, column, length of lookahead symbol*)
  22         errors*: INTEGER;  (*number of errors detected*)
  23         Error*: ErrorProc;
  24
  25         ch: CHAR;        (*current input character*)
  26         r: Texts.Reader;        (*global reader*)
  27         chPos: LONGINT; (*position of current character*)
  28         chLine: INTEGER;  (*current line number*)
  29         lineStart: LONGINT;  (*start position of current line*)
  30         apx: INTEGER;     (*length of appendix*)
  31         oldEols: INTEGER;     (*nr. of EOLs in a comment*)
  32
  33         start: StartTable;  (*start state for every character*)
  34
  35
  36 PROCEDURE NextCh; (*return global variable ch*)
  37 BEGIN
  38         Texts.Read(r, ch); INC(chPos);
  39         IF ch = EOL THEN INC(chLine); lineStart := chPos + 1 END
  40 END NextCh;
  41
  42
  43 PROCEDURE Comment(): BOOLEAN;
  44         VAR level, startLine: INTEGER; oldLineStart: LONGINT;
  45 BEGIN (*Comment*)
  46         level := 1; startLine := chLine; oldLineStart := lineStart;
  47   IF (ch ="(") THEN
  48     NextCh;
  49     IF (ch ="*") THEN
  50       NextCh;
  51       LOOP
  52         IF (ch ="*") THEN
  53           NextCh;
  54           IF (ch =")") THEN
  55             DEC(level); oldEols := chLine - startLine; NextCh;
  56             IF level=0 THEN RETURN TRUE END
  57           END;
  58         ELSIF (ch ="(") THEN
  59           NextCh;
  60           IF (ch ="*") THEN
  61             INC(level); NextCh;
  62           END;
  63         ELSIF ch = EOF THEN RETURN FALSE
  64         ELSE NextCh END;
  65       END;
  66     ELSE
  67       IF ch = EOL THEN DEC(chLine); lineStart := oldLineStart END;
  68       DEC(chPos, 2); Texts.OpenReader(r, src, chPos+1); NextCh; RETURN FALSE
  69     END
  70   END;
  71 END Comment;
  72
  73
  74 PROCEDURE Get*(VAR sym: INTEGER);
  75 VAR state: INTEGER; lexeme: ARRAY maxLexLen+1 OF CHAR;
  76
  77         PROCEDURE CheckLiteral;
  78         BEGIN
  79                 IF nextLen < maxLexLen THEN lexeme[nextLen] := 0X END;
  80     IF (lexeme[0] >= "A") & (lexeme[0] <= "W") THEN
  81       CASE lexeme[0] OF
  82       | "A": IF lexeme = "ANY" THEN sym := 25
  83         END
  84       | "C": IF lexeme = "CASE" THEN sym := 19
  85         ELSIF lexeme = "CHARACTERS" THEN sym := 11
  86         ELSIF lexeme = "CHR" THEN sym := 22
  87         ELSIF lexeme = "COMMENTS" THEN sym := 14
  88         ELSIF lexeme = "COMPILER" THEN sym := 4
  89         ELSIF lexeme = "CONTEXT" THEN sym := 33
  90         END
  91       | "E": IF lexeme = "END" THEN sym := 10
  92         END
  93       | "F": IF lexeme = "FROM" THEN sym := 15
  94         END
  95       | "I": IF lexeme = "IGNORE" THEN sym := 18
  96         ELSIF lexeme = "IMPORT" THEN sym := 5
  97         END
  98       | "N": IF lexeme = "NESTED" THEN sym := 17
  99         END
 100       | "P": IF lexeme = "PRAGMAS" THEN sym := 13
 101         ELSIF lexeme = "PRODUCTIONS" THEN sym := 7
 102         END
 103       | "S": IF lexeme = "SYNC" THEN sym := 32
 104         END
 105       | "T": IF lexeme = "TO" THEN sym := 16
 106         ELSIF lexeme = "TOKENS" THEN sym := 12
 107         END
 108       | "W": IF lexeme = "WEAK" THEN sym := 27
 109         END
 110       ELSE
 111       END
 112     END;
 113
 114         END CheckLiteral;
 115
 116 BEGIN
 117   WHILE (ch=20X) OR (ch=CHR(9)) OR (ch=CHR(13)) OR (ch=CHR(28)) DO NextCh END;
 118     IF ((ch ="(")) & Comment() THEN Get(sym); RETURN END;
 119         IF ch > 7FX THEN ch := " " END;
 120         pos := nextPos; col := nextCol; line := nextLine; len := nextLen;
 121         nextPos := chPos; nextCol := SHORT(chPos - lineStart); nextLine := chLine; nextLen := 0;
 122         state := start[ORD(ch)]; apx := 0;
 123         LOOP
 124                 IF nextLen < maxLexLen THEN lexeme[nextLen] := ch END;
 125                 INC(nextLen);
 126                 NextCh;
 127                 IF state > 0 THEN
 128                         CASE state OF
 129     |  1: IF (ch>="0") & (ch<="9") OR (ch>="A") & (ch<="Z") OR (ch>="a") & (ch<="z") THEN
 130           ELSE sym := 1; CheckLiteral; RETURN
 131           END;
 132     |  2: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="!") OR (ch>="#") THEN
 133           ELSIF (ch =CHR(34)) THEN state := 3;
 134           ELSE sym := noSym; RETURN
 135           END;
 136     |  3: sym := 2; RETURN
 137     |  4: IF (ch<=CHR(12)) OR (ch>=CHR(14)) & (ch<="&") OR (ch>="(") THEN
 138           ELSIF (ch ="'") THEN state := 3;
 139           ELSE sym := noSym; RETURN
 140           END;
 141     |  5: IF (ch>="0") & (ch<="9") THEN
 142           ELSE sym := 3; RETURN
 143           END;
 144     |  6: IF (ch>="0") & (ch<="9") THEN
 145           ELSE sym := 39; RETURN
 146           END;
 147     |  7: sym := 6; RETURN
 148     |  8: sym := 8; RETURN
 149     |  9: IF (ch =")") THEN state := 22;
 150           ELSE sym := 9; RETURN
 151           END;
 152     | 10: sym := 20; RETURN
 153     | 11: sym := 21; RETURN
 154     | 12: IF (ch =".") THEN state := 21;
 155           ELSE sym := 23; RETURN
 156           END;
 157     | 13: sym := 24; RETURN
 158     | 14: sym := 26; RETURN
 159     | 15: sym := 28; RETURN
 160     | 16: sym := 29; RETURN
 161     | 17: sym := 30; RETURN
 162     | 18: sym := 31; RETURN
 163     | 19: sym := 34; RETURN
 164     | 20: sym := 35; RETURN
 165     | 21: sym := 36; RETURN
 166     | 22: sym := 37; RETURN
 167     | 23: sym := 0; ch := 0X; RETURN
 168
 169                         END (*CASE*)
 170                 ELSE sym := noSym; RETURN (*NextCh already done*)
 171                 END (*IF*)
 172         END (*LOOP*)
 173 END Get;
 174
 175
 176 PROCEDURE GetName*(pos: LONGINT; len: INTEGER; VAR s: ARRAY OF CHAR);
 177         VAR i: INTEGER; r: Texts.Reader;
 178 BEGIN
 179         Texts.OpenReader(r, src, pos);
 180         IF len >= LEN(s) THEN len := SHORT(LEN(s)) - 1 END;
 181         i := 0; WHILE i < len DO Texts.Read(r, s[i]); INC(i) END;
 182         s[i] := 0X
 183 END GetName;
 184
 185 PROCEDURE StdErrorProc* (n: INTEGER; pos: LONGINT);
 186 BEGIN INC(errors) END StdErrorProc;
 187
 188 PROCEDURE Reset* (t: Texts.Text; pos: LONGINT; errProc: ErrorProc);
 189 BEGIN
 190         src := t; Error := errProc;
 191         Texts.OpenReader(r, src, pos);
 192         chPos := pos - 1; chLine := 1; lineStart := 0;
 193         oldEols := 0; apx := 0; errors := 0;
 194         NextCh
 195 END Reset;
 196
 197 BEGIN
 198   start[0]:=23; start[1]:=0; start[2]:=0; start[3]:=0;
 199   start[4]:=0; start[5]:=0; start[6]:=0; start[7]:=0;
 200   start[8]:=0; start[9]:=0; start[10]:=0; start[11]:=0;
 201   start[12]:=0; start[13]:=0; start[14]:=0; start[15]:=0;
 202   start[16]:=0; start[17]:=0; start[18]:=0; start[19]:=0;
 203   start[20]:=0; start[21]:=0; start[22]:=0; start[23]:=0;
 204   start[24]:=0; start[25]:=0; start[26]:=0; start[27]:=0;
 205   start[28]:=0; start[29]:=0; start[30]:=0; start[31]:=0;
 206   start[32]:=0; start[33]:=0; start[34]:=2; start[35]:=0;
 207   start[36]:=6; start[37]:=0; start[38]:=0; start[39]:=4;
 208   start[40]:=12; start[41]:=13; start[42]:=0; start[43]:=10;
 209   start[44]:=0; start[45]:=11; start[46]:=9; start[47]:=0;
 210   start[48]:=5; start[49]:=5; start[50]:=5; start[51]:=5;
 211   start[52]:=5; start[53]:=5; start[54]:=5; start[55]:=5;
 212   start[56]:=5; start[57]:=5; start[58]:=0; start[59]:=7;
 213   start[60]:=19; start[61]:=8; start[62]:=20; start[63]:=0;
 214   start[64]:=0; start[65]:=1; start[66]:=1; start[67]:=1;
 215   start[68]:=1; start[69]:=1; start[70]:=1; start[71]:=1;
 216   start[72]:=1; start[73]:=1; start[74]:=1; start[75]:=1;
 217   start[76]:=1; start[77]:=1; start[78]:=1; start[79]:=1;
 218   start[80]:=1; start[81]:=1; start[82]:=1; start[83]:=1;
 219   start[84]:=1; start[85]:=1; start[86]:=1; start[87]:=1;
 220   start[88]:=1; start[89]:=1; start[90]:=1; start[91]:=15;
 221   start[92]:=0; start[93]:=16; start[94]:=0; start[95]:=0;
 222   start[96]:=0; start[97]:=1; start[98]:=1; start[99]:=1;
 223   start[100]:=1; start[101]:=1; start[102]:=1; start[103]:=1;
 224   start[104]:=1; start[105]:=1; start[106]:=1; start[107]:=1;
 225   start[108]:=1; start[109]:=1; start[110]:=1; start[111]:=1;
 226   start[112]:=1; start[113]:=1; start[114]:=1; start[115]:=1;
 227   start[116]:=1; start[117]:=1; start[118]:=1; start[119]:=1;
 228   start[120]:=1; start[121]:=1; start[122]:=1; start[123]:=17;
 229   start[124]:=14; start[125]:=18; start[126]:=0; start[127]:=0;
 230
 231 END CRS.