(* ------------------- VERSION 4 14.05.86 ------------------- *)
PACKET scanner DEFINES (* Autor: J.Liedtke *)
scan ,
continue scan ,
next symbol :
LET tag = 1 ,
bold = 2 ,
number = 3 ,
text = 4 ,
operator= 5 ,
delimiter = 6 ,
end of file = 7 ,
within comment = 8 ,
within text = 9 ;
LET digit 0 = 48 ,
digit 9 = 57 ,
upper case a = 65 ,
upper case z = 90 ,
lower case a = 97 ,
lower case z = 122;
TEXT VAR line := "" ,
char := "" ,
chars:= "" ;
INT VAR position := 0 ,
comment depth ;
BOOL VAR continue text ;
PROC scan (TEXT CONST scan text) :
comment depth := 0 ;
continue text := FALSE ;
continue scan (scan text)
ENDPROC scan ;
PROC continue scan (TEXT CONST scan text) :
line := scan text ;
position := 0 ;
nextchar
ENDPROC continue scan ;
PROC next symbol (TEXT VAR symbol) :
INT VAR type ;
next symbol (symbol, type)
ENDPROC next symbol ;
PROC next symbol (TEXT VAR symbol, INT VAR type) :
skip blanks ;
IF is begin comment THEN process comment
ELIF comment depth > 0 THEN comment depth DECR 1 ;
process comment
ELIF is quote OR continue text THEN process text
ELIF is lower case letter THEN process tag
ELIF is upper case letter THEN process bold
ELIF is digit THEN process number
ELIF is delimiter THEN process delimiter
ELIF is niltext THEN eof
ELSE process operator
FI .
process comment :
read comment ;
IF comment depth = 0
THEN next symbol (symbol, type)
ELSE type := within comment ;
symbol := ""
FI .
process tag :
type := tag ;
assemble chars (lower case a, lower case z) ;
symbol := chars ;
REP
skip blanks ;
IF is lower case letter
THEN assemble chars (lower case a, lower case z)
ELIF is digit
THEN assemble chars (digit 0, digit 9)
ELSE LEAVE process tag
FI ;
symbol CAT chars
PER ;
nextchar .
process bold :
type := bold ;
assemble chars (upper case a, upper case z) ;
symbol := chars .
process number :
type := number ;
assemble chars (digit 0, digit 9) ;
symbol := chars ;
IF char = "." AND ahead char is digit
THEN process fraction ;
IF char = "e"
THEN process exponent
FI
FI .
ahead char is digit :
digit 0 <= code (ahead char) AND code (ahead char) <= digit 9 .
process fraction :
symbol CAT char ;
nextchar ;
assemble chars (digit 0, digit 9) ;
symbol CAT chars .
process exponent :
symbol CAT char ;
nextchar ;
IF char = "+" OR char = "-"
THEN symbol CAT char ;
nextchar
FI ;
assemble chars (digit 0, digit 9) ;
symbol CAT chars .
process text :
type := text ;
symbol := "" ;
IF continue text
THEN continue text := FALSE
ELSE next char
FI ;
WHILE not end of text REP
assemble chars (35, 254) ;
symbol CAT chars ;
IF NOT is quote
THEN symbol CAT char ;
nextchar
FI
ENDREP .
not end of text :
IF is niltext
THEN continue text := TRUE ; type := within text ; FALSE
ELIF is quote
THEN end of text or exception
ELSE TRUE
FI .
end of text or exception :
next char ;
IF is quote
THEN get quote ; TRUE
ELIF is digit
THEN get special char ; TRUE
ELSE FALSE
FI .
get quote :
symbol CAT char ;
nextchar .
get special char :
assemble chars (digit 0, digit 9) ;
symbol CAT code (int (chars) ) ;
nextchar .
process delimiter :
type := delimiter ;
symbol := char ;
nextchar .
process operator :
type := operator ;
symbol := char ;
nextchar ;
IF symbol = ":"
THEN IF char = "=" OR char = ":"
THEN symbol := ":=" ;
nextchar
ELSE type := delimiter
FI
ELIF is relational double char
THEN symbol CAT char ;
nextchar
ELIF symbol = "*" AND char = "*"
THEN symbol := "**" ;
next char
FI .
eof :
type := end of file ;
symbol := "" .
is lower case letter :
lower case a <= code (char) AND code (char) <= lower case z .
is upper case letter :
upper case a <= code (char) AND code (char) <= upper case z .
is digit :
digit 0 <= code (char) AND code (char) <= digit 9 .
is delimiter : pos ( "()[].,;" , char ) > 0 .
is relational double char :
TEXT VAR double := symbol + char ;
double = "<>" OR double = "<=" OR double = ">=" .
is quote : char = """" .
is niltext : char = "" .
is begin comment : char = "{" OR char = "(" AND ahead char = "*" .
ENDPROC next symbol ;
PROC next char :
position INCR 1 ;
char := line SUB position
ENDPROC next char ;
PROC skip blanks :
position := pos (line, ""33"", ""254"", position) ;
IF position = 0
THEN position := LENGTH line + 1
FI ;
char := line SUB position .
ENDPROC skip blanks ;
TEXT PROC ahead char :
line SUB position+1
ENDPROC ahead char ;
PROC assemble chars (INT CONST low, high) :
INT CONST begin := position ;
position behind valid text ;
chars := subtext (line, begin, position-1) ;
char := line SUB position .
position behind valid text :
position := pos (line, ""32"", code (low-1), begin) ;
IF position = 0
THEN position := LENGTH line + 1
FI ;
INT CONST higher pos := pos (line, code (high+1), ""254"", begin) ;
IF higher pos <> 0 AND higher pos < position
THEN position := higher pos
FI .
ENDPROC assemble chars ;
PROC read comment :
TEXT VAR last char ;
comment depth INCR 1 ;
REP
last char := char ;
nextchar ;
IF is begin comment
THEN read comment
FI ;
IF char = ""
THEN LEAVE read comment
FI
UNTIL is end comment PER ;
comment depth DECR 1 ;
next char ;
skip blanks .
is end comment :
char = "}" OR char = ")" AND last char = "*" .
is begin comment :
char = "{" OR char = "(" AND ahead char = "*" .
ENDPROC read comment ;
PROC scan (FILE VAR f) :
getline (f, line) ;
scan (line)
ENDPROC scan ;
PROC next symbol (FILE VAR f, TEXT VAR symbol) :
INT VAR type ;
next symbol (f, symbol, type)
ENDPROC next symbol ;
TEXT VAR scanned ;
PROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type) :
next symbol (symbol, type) ;
WHILE type >= 7 AND NOT eof (f) REP
getline (f, line) ;
continue scan (line) ;
next symbol (scanned, type) ;
symbol CAT scanned
PER .
ENDPROC next symbol ;
ENDPACKET scanner ;