1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
PACKET scanner DEFINES (* Autor: J.Liedtke *)
(* Stand: 30.12.81 *)
scan ,
continue scan ,
next symbol ,
fix scanner ,
reset scanner :
LET tag = 1 ,
bold = 2 ,
integer = 3 ,
text = 4 ,
operator= 5 ,
delimiter = 6 ,
end of file = 7 ,
within comment = 8 ,
within text = 9 ;
TEXT VAR line := "" ,
char := "" ;
INT VAR position := 0 ,
reset position ,
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 ;
next non blank char ;
reset position := position
ENDPROC continue scan ;
PROC fix scanner :
reset position := position
ENDPROC fix scanner ;
PROC reset scanner :
position := reset position ;
char := line SUB position
ENDPROC reset scanner ;
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 ;
symbol := "" ;
IF is niltext THEN eof
ELIF is comment THEN process comment
ELIF is 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 integer
ELIF is delimiter THEN process delimiter
ELSE process operator
FI .
skip blanks :
IF char = " "
THEN next non blank char
FI .
process comment :
read comment ;
IF comment depth = 0
THEN next symbol (symbol, type)
ELSE type := within comment
FI .
process tag :
type := tag ;
REP
symbol CAT char ;
next non blank char
UNTIL NOT (is lower case letter OR is digit) ENDREP .
process bold :
type := bold ;
REP
symbol CAT char ;
next char
UNTIL NOT is upper case letter ENDREP .
process integer :
type := integer ;
REP
symbol CAT char ;
next non blank char
UNTIL NOT (is digit OR char = ".") ENDREP .
process text :
type := text ;
IF continue text
THEN continue text := FALSE
ELSE next char
FI ;
WHILE not end of text REP
symbol CAT char ;
next char
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 TRUE
ELIF is digit
THEN get special char ; TRUE
ELSE FALSE
FI .
get special char :
TEXT VAR special symbol ;
next symbol (special symbol) ;
char := code ( int (special symbol ) ) .
process delimiter :
type := delimiter ;
symbol := char ;
next non blank char .
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 : char lies in (97, 122) .
is upper case letter : char lies in (65, 90) .
is digit : char lies in (48, 57) .
is delimiter : pos ( "()[].,;" , char ) > 0 AND char <> "" .
is relational double char :
TEXT VAR double := symbol + char ;
double = "<>" OR double = "<=" OR double = ">=" .
is text : is quote OR continue text .
is quote : char = """" .
is niltext : char = "" .
is comment :
IF comment depth = 0
THEN char = "{" OR char = "(" AND ahead char = "*"
ELSE comment depth DECR 1 ; TRUE
FI .
ENDPROC next symbol ;
PROC next char :
position INCR 1 ;
char := line SUB position
ENDPROC next char ;
PROC next non blank char :
REP
position INCR 1
UNTIL (line SUB position) <> " " ENDREP ;
char := line SUB position
ENDPROC next non blank char ;
TEXT PROC ahead char :
line SUB position+1
ENDPROC ahead char ;
BOOL PROC char lies in (INT CONST lower bound, upper bound) :
lower bound <= code(char) AND code(char) <= upper bound
ENDPROC char lies in ;
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 nonblank char .
is end comment :
char = "}" OR char = ")" AND last char = "*" .
is begin comment :
char = "{" OR char = "(" AND ahead char = "*" .
ENDPROC read comment ;
ENDPACKET scanner ;
|
