MODULE ReleaseVisualizerScanner;
IMPORT
Texts, Streams, UTF8Strings, Strings;
CONST
Eot* = 0X;
ObjectMarker = 020X;
char* = 1; integer* = 2; longinteger* = 3; real* = 4; longreal* = 5;
null* = 0; times* = 1; slash* = 2; div* = 3; mod* = 4; and* = 5;
plus* = 6; minus* = 7; or* = 8; eql* = 9; neq* = 10; lss* = 11;
leq* = 12; gtr* = 13; geq* = 14; in* = 15; is* = 16; arrow* = 17;
period* = 18; comma* = 19; colon* = 20; upto* = 21; rparen* = 22;
rbrak* = 23; rbrace* = 24; of* = 25; then* = 26; do* = 27; to* = 28;
by* = 29; lparen* = 30; lbrak* = 31; lbrace* = 32; not* = 33;
becomes* = 34; number* = 35; nil* = 36; true* = 37; false* = 38;
string* = 39; ident* = 40; semicolon* = 41; bar* = 42; end* = 43;
else* = 44; elsif* = 45; until* = 46; if* = 47; case* = 48; while* = 49;
repeat* = 50; for* = 51; loop* = 52; with* = 53; exit* = 54;
passivate* = 55; return* = 56; refines* = 57; implements* = 58;
array* = 59; definition* = 60; object* = 61; record* = 62; pointer* = 63;
begin* = 64; code* = 65; const* = 66; type* = 67; var* = 68;
procedure* = 69; import* = 70; module* = 71; eof* = 72;
comment* = 73;
VAR
reservedChar-, newChar: ARRAY 256 OF BOOLEAN;
TYPE
StringMaker* = OBJECT
VAR
length : LONGINT;
data : Strings.String;
PROCEDURE &Init(initialSize : LONGINT);
BEGIN
IF initialSize < 256 THEN initialSize := 256 END;
NEW(data, initialSize); length := 0;
END Init;
PROCEDURE Add*(CONST buf: ARRAY OF CHAR; ofs, len: LONGINT; propagate: BOOLEAN; VAR res: LONGINT);
VAR i : LONGINT; n : Strings.String;
BEGIN
IF length + len + 1 >= LEN(data) THEN
NEW(n, LEN(data) + len + 1); FOR i := 0 TO length - 1 DO n[i] := data[i] END;
data := n
END;
WHILE len > 0 DO
data[length] := buf[ofs];
INC(ofs); INC(length); DEC(len)
END;
data[length] := 0X;
END Add;
PROCEDURE Clear*;
BEGIN
data[0] := 0X;
length := 0
END Clear;
PROCEDURE GetWriter*() : Streams.Writer;
VAR w : Streams.Writer;
BEGIN
NEW(w, SELF.Add, 256);
RETURN w
END GetWriter;
PROCEDURE GetLength*() : LONGINT;
BEGIN
RETURN length
END GetLength;
PROCEDURE GetString*() : Strings.String;
BEGIN
RETURN data
END GetString;
END StringMaker;
Scanner* = OBJECT
VAR
buffer: Strings.String;
pos: LONGINT;
ch-: CHAR;
str-: ARRAY 1024 OF CHAR;
sym- : LONGINT;
numStartPos, numEndPos: LONGINT;
curpos-, errpos-: LONGINT;
isNummer: BOOLEAN;
commentStr- : StringMaker;
cw : Streams.Writer;
PROCEDURE &Init;
BEGIN
NEW(commentStr, 1024);
cw := commentStr.GetWriter()
END Init;
PROCEDURE err(n: INTEGER);
BEGIN
END err;
PROCEDURE NextChar*;
BEGIN
IF pos < LEN(buffer) THEN
ch := buffer[pos]; INC(pos)
ELSE
ch := Eot
END;
IF newChar[ORD(ch)] THEN INC(curpos) END;
END NextChar;
PROCEDURE Str(VAR sym: LONGINT);
VAR i: LONGINT; och: CHAR;
BEGIN i := 0; och := ch;
LOOP NextChar;
IF ch = och THEN EXIT END ;
IF ch < " " THEN err(3); EXIT END ;
IF i = LEN(str)-1 THEN err(241); EXIT END ;
str[i] := ch; INC(i)
END ;
NextChar; str[i] := 0X;
IF i = 1 THEN
sym := number
ELSE sym := string
END
END Str;
PROCEDURE Identifier(VAR sym: LONGINT);
VAR i: LONGINT;
BEGIN i := 0;
REPEAT
str[i] := ch; INC(i); NextChar
UNTIL reservedChar[ORD(ch)] OR (i = LEN(str));
IF i = LEN(str) THEN err(240); DEC(i) END ;
str[i] := 0X; sym := ident;
IF str = "ANY" THEN COPY("PTR", str) END;
END Identifier;
PROCEDURE GetNumAsString*(VAR val: ARRAY OF CHAR);
VAR i, l: LONGINT;
BEGIN
IF isNummer THEN
i := 0; l := LEN(val)-1;
WHILE (i < numEndPos-numStartPos) & (i < l) DO
val[i] := buffer[numStartPos + i];
INC(i);
END;
END;
val[i] := 0X
END GetNumAsString;
PROCEDURE Get(VAR s: LONGINT);
PROCEDURE Comment;
BEGIN NextChar; cw.Char(ch);
LOOP
LOOP
WHILE ch = "(" DO NextChar; cw.Char(ch);
IF ch = "*" THEN Comment END
END;
IF ch = "*" THEN NextChar; cw.Char(ch); EXIT END ;
IF ch = Eot THEN EXIT END ;
NextChar; cw.Char(ch);
END ;
IF ch = ")" THEN NextChar; cw.Char(ch); EXIT END ;
IF ch = Eot THEN err(5); EXIT END
END
END Comment;
BEGIN
REPEAT
WHILE ch <= " " DO
IF ch = Eot THEN
s := eof; RETURN
ELSE NextChar
END
END ;
errpos := curpos - 1;
isNummer := FALSE;
CASE ch OF
| 22X, 27X : Str(s)
| "#" : s := neq; NextChar
| "&" : s := and; NextChar
| "(" : NextChar;
IF ch = "*" THEN commentStr.Clear; Comment; cw.Update; s := comment;
ELSE s := lparen
END
| ")" : s := rparen; NextChar
| "*" : s:=times; NextChar
| "+" : s := plus; NextChar
| "," : s := comma; NextChar
| "-" : s := minus; NextChar
| "." : NextChar;
IF ch = "." THEN NextChar; s := upto ELSE s := period END
| "/" : s := slash; NextChar
| "0".."9": isNummer := TRUE; numStartPos := pos-1; numEndPos := pos-1; s := number
| ":" : NextChar;
IF ch = "=" THEN NextChar; s := becomes ELSE s := colon END
| ";" : s := semicolon; NextChar
| "<" : NextChar;
IF ch = "=" THEN NextChar; s := leq; ELSE s := lss; END
| "=" : s := eql; NextChar
| ">" : NextChar;
IF ch = "=" THEN NextChar; s := geq; ELSE s := gtr; END
| "A": Identifier(s);
IF str = "ARRAY" THEN s := array
ELSIF str = "AWAIT" THEN s := passivate
END
| "B": Identifier(s);
IF str = "BEGIN" THEN s := begin
ELSIF str = "BY" THEN s := by
END
| "C": Identifier(s);
IF str = "CONST" THEN s := const
ELSIF str = "CASE" THEN s := case
ELSIF str = "CODE" THEN s := code
END
| "D": Identifier(s);
IF str = "DO" THEN s := do
ELSIF str = "DIV" THEN s := div
ELSIF str = "DEFINITION" THEN s := definition
END
| "E": Identifier(s);
IF str = "END" THEN s := end
ELSIF str = "ELSE" THEN s := else
ELSIF str = "ELSIF" THEN s := elsif
ELSIF str = "EXIT" THEN s := exit
END
| "F": Identifier(s);
IF str = "FALSE" THEN s := false
ELSIF str = "FOR" THEN s := for
END
| "I": Identifier(s);
IF str = "IF" THEN s := if
ELSIF str = "IN" THEN s := in
ELSIF str = "IS" THEN s := is
ELSIF str = "IMPORT" THEN s := import
ELSIF str = "IMPLEMENTS" THEN s := implements
END
| "L": Identifier(s);
IF str = "LOOP" THEN s := loop END
| "M": Identifier(s);
IF str = "MOD" THEN s := mod
ELSIF str = "MODULE" THEN s := module
END
| "N": Identifier(s);
IF str = "NIL" THEN s := nil END
| "O": Identifier(s);
IF str = "OR" THEN s := or
ELSIF str = "OF" THEN s := of
ELSIF str = "OBJECT" THEN s := object
END
| "P": Identifier(s);
IF str = "PROCEDURE" THEN s := procedure
ELSIF str = "POINTER" THEN s := pointer
END
| "R": Identifier(s);
IF str = "RECORD" THEN s := record
ELSIF str = "REPEAT" THEN s := repeat
ELSIF str = "RETURN" THEN s := return
ELSIF str = "REFINES" THEN s := refines
END
| "T": Identifier(s);
IF str = "THEN" THEN s := then
ELSIF str = "TRUE" THEN s := true
ELSIF str = "TO" THEN s := to
ELSIF str = "TYPE" THEN s := type
END
| "U": Identifier(s);
IF str = "UNTIL" THEN s := until END
| "V": Identifier(s);
IF str = "VAR" THEN s := var END
| "W": Identifier(s);
IF str = "WHILE" THEN s := while
ELSIF str = "WITH" THEN s := with
END
| "G".."H", "J", "K", "Q", "S", "X".."Z": Identifier(s)
| "[" : s := lbrak; NextChar
| "]" : s := rbrak; NextChar
| "^" : s := arrow; NextChar
| "a".."z": Identifier(s)
| "{" : s := lbrace; NextChar
| "|" : s := bar; NextChar
| "}" : s := rbrace; NextChar
| "~" : s := not; NextChar
| 7FX : s := upto; NextChar
ELSE Identifier(s);
END ;
UNTIL s >= 0;
END Get;
PROCEDURE Next*;
BEGIN
Get(sym)
END Next;
END Scanner;
PROCEDURE InitWithText*(t: Texts.Text; pos: LONGINT): Scanner;
VAR buffer: Strings.String; len, i, j, ch: LONGINT; r: Texts.TextReader;
bytesPerChar: LONGINT;
s : Scanner;
BEGIN
t.AcquireRead;
len := t.GetLength();
bytesPerChar := 2;
NEW(buffer, len * bytesPerChar);
NEW(r, t);
r.SetPosition(pos);
j := 0;
FOR i := 0 TO len-1 DO
r.ReadCh(ch);
WHILE ~UTF8Strings.EncodeChar(ch, buffer^, j) DO
INC(bytesPerChar);
ExpandBuf(buffer, bytesPerChar * len);
END;
END;
t.ReleaseRead;
NEW(s); s.buffer := buffer;
s.pos := 0;
s.ch := " ";
RETURN s;
END InitWithText;
PROCEDURE ExpandBuf(VAR oldBuf: Strings.String; newSize: LONGINT);
VAR newBuf: Strings.String; i: LONGINT;
BEGIN
IF LEN(oldBuf^) >= newSize THEN RETURN END;
NEW(newBuf, newSize);
FOR i := 0 TO LEN(oldBuf^)-1 DO
newBuf[i] := oldBuf[i];
END;
oldBuf := newBuf;
END ExpandBuf;
PROCEDURE InitReservedChars;
VAR
i: LONGINT;
BEGIN
FOR i := 0 TO LEN(reservedChar)-1 DO
IF CHR(i) <= 20X THEN
reservedChar[i] := TRUE;
ELSE
CASE CHR(i) OF
| "#", "&", "(", ")", "*", "+", ",", "-", ".", "/": reservedChar[i] := TRUE;
| ":", ";", "<", "=", ">": reservedChar[i] := TRUE;
| "[", "]", "^", "{", "|", "}", "~": reservedChar[i] := TRUE;
| "$": reservedChar[i] := TRUE;
| 22X, 27X, 7FX: reservedChar[i] := TRUE;
ELSE
reservedChar[i] := FALSE;
END;
END;
END;
END InitReservedChars;
PROCEDURE InitNewChar;
VAR
i: LONGINT;
BEGIN
FOR i := 0 TO LEN(newChar)-1 DO
IF (i < 80H) OR (i > 0BFH) THEN
newChar[i] := TRUE;
ELSE
newChar[i] := FALSE;
END
END
END InitNewChar;
BEGIN
InitReservedChars;
InitNewChar;
END ReleaseVisualizerScanner.