]>
Commit | Line | Data |
---|---|---|
1eee94d3 GM |
1 | -- |
2 | -- mc-3.bnf grammar and associated actions for mcp3. | |
3 | -- | |
a945c346 | 4 | -- Copyright (C) 2015-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
5 | -- Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
6 | -- | |
7 | -- This file is part of GNU Modula-2. | |
8 | -- | |
9 | -- GNU Modula-2 is free software; you can redistribute it and/or modify | |
10 | -- it under the terms of the GNU General Public License as published by | |
11 | -- the Free Software Foundation; either version 3, or (at your option) | |
12 | -- any later version. | |
13 | -- | |
14 | -- GNU Modula-2 is distributed in the hope that it will be useful, but | |
15 | -- WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 | -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
17 | -- General Public License for more details. | |
18 | -- | |
19 | -- You should have received a copy of the GNU General Public License | |
20 | -- along with GNU Modula-2; see the file COPYING3. If not see | |
21 | -- <http://www.gnu.org/licenses/>. | |
22 | % module mcp3 begin | |
23 | (* output from mc-3.bnf, automatically generated do not edit. | |
24 | ||
a945c346 | 25 | Copyright (C) 2015-2024 Free Software Foundation, Inc. |
1eee94d3 GM |
26 | Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>. |
27 | ||
28 | This file is part of GNU Modula-2. | |
29 | ||
30 | GNU Modula-2 is free software; you can redistribute it and/or modify | |
31 | it under the terms of the GNU General Public License as published by | |
32 | the Free Software Foundation; either version 3, or (at your option) | |
33 | any later version. | |
34 | ||
35 | GNU Modula-2 is distributed in the hope that it will be useful, but | |
36 | WITHOUT ANY WARRANTY; without even the implied warranty of | |
37 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
38 | General Public License for more details. | |
39 | ||
40 | You should have received a copy of the GNU General Public License | |
41 | along with GNU Modula-2; see the file COPYING. If not, | |
42 | see <https://www.gnu.org/licenses/>. *) | |
43 | ||
44 | IMPLEMENTATION MODULE mcp3 ; | |
45 | ||
46 | FROM DynamicStrings IMPORT String, InitString, KillString, Mark, | |
47 | ConCat, ConCatChar ; | |
48 | ||
49 | FROM mcError IMPORT errorStringAt ; | |
50 | FROM nameKey IMPORT NulName, Name, makekey, makeKey ; | |
51 | FROM mcPrintf IMPORT printf0, printf1 ; | |
52 | FROM mcDebug IMPORT assert ; | |
53 | FROM mcReserved IMPORT toktype ; | |
54 | FROM mcMetaError IMPORT metaError1, metaError2 ; | |
55 | FROM mcStack IMPORT stack ; | |
56 | ||
57 | IMPORT mcStack ; | |
58 | ||
59 | FROM mcLexBuf IMPORT currentstring, currenttoken, getToken, insertToken, | |
60 | insertTokenAndRewind, getTokenNo ; | |
61 | ||
62 | FROM decl IMPORT node, lookupDef, lookupImp, lookupModule, getSymName, | |
63 | putTypeHidden, | |
64 | enterScope, leaveScope, | |
65 | putType, lookupSym, isDef, makeSubrange, | |
66 | makeSet, makePointer, makeProcType, | |
67 | putReturnType, putOptReturn, | |
68 | addParameter, paramEnter, paramLeave, | |
69 | makeVarargs, makeVarParameter, makeNonVarParameter, | |
70 | putSubrangeType, putConst, | |
71 | makeArray, putUnbounded, getCardinal, | |
72 | makeRecord, isRecord, isRecordField, isVarientField, makeVarient, | |
73 | addFieldsToRecord, isVarient, buildVarientSelector, | |
74 | buildVarientFieldRecord, makeVarDecl, addOptParameter, | |
75 | makeIdentList, putIdent, addVarParameters, addNonVarParameters, | |
76 | lookupInScope, import, lookupExported, isImp, isModule, isConst, | |
77 | makeLiteralInt, makeLiteralReal, makeString, getBuiltinConst, | |
78 | getNextEnum, resetEnumPos, makeConstExp, setConstExpComplete, | |
79 | makeEnum, makeEnumField, setNoReturn ; | |
80 | ||
81 | ||
82 | CONST | |
83 | Pass1 = FALSE ; | |
84 | Debugging = FALSE ; | |
85 | ||
86 | VAR | |
87 | WasNoError : BOOLEAN ; | |
88 | curisused : BOOLEAN ; | |
89 | curstring, | |
90 | curident : Name ; | |
91 | curproc, | |
92 | frommodule, | |
93 | typeDes, | |
94 | typeExp, | |
95 | curmodule : node ; | |
96 | stk : stack ; | |
97 | ||
98 | ||
99 | (* | |
100 | push - | |
101 | *) | |
102 | ||
103 | PROCEDURE push (n: node) : node ; | |
104 | BEGIN | |
105 | RETURN mcStack.push (stk, n) | |
106 | END push ; | |
107 | ||
108 | ||
109 | (* | |
110 | pop - | |
111 | *) | |
112 | ||
113 | PROCEDURE pop () : node ; | |
114 | BEGIN | |
115 | RETURN mcStack.pop (stk) | |
116 | END pop ; | |
117 | ||
118 | ||
119 | (* | |
120 | replace - | |
121 | *) | |
122 | ||
123 | PROCEDURE replace (n: node) : node ; | |
124 | BEGIN | |
125 | RETURN mcStack.replace (stk, n) | |
126 | END replace ; | |
127 | ||
128 | ||
129 | (* | |
130 | peep - returns the top node on the stack without removing it. | |
131 | *) | |
132 | ||
133 | PROCEDURE peep () : node ; | |
134 | BEGIN | |
135 | RETURN push (pop ()) | |
136 | END peep ; | |
137 | ||
138 | ||
139 | (* | |
140 | depth - returns the depth of the stack. | |
141 | *) | |
142 | ||
143 | PROCEDURE depth () : CARDINAL ; | |
144 | BEGIN | |
145 | RETURN mcStack.depth (stk) | |
146 | END depth ; | |
147 | ||
148 | ||
149 | (* | |
150 | checkDuplicate - | |
151 | *) | |
152 | ||
153 | PROCEDURE checkDuplicate (b: BOOLEAN) ; | |
154 | BEGIN | |
155 | ||
156 | END checkDuplicate ; | |
157 | ||
158 | ||
159 | PROCEDURE ErrorString (s: String) ; | |
160 | BEGIN | |
161 | errorStringAt (s, getTokenNo ()) ; | |
162 | WasNoError := FALSE | |
163 | END ErrorString ; | |
164 | ||
165 | ||
166 | PROCEDURE ErrorArray (a: ARRAY OF CHAR) ; | |
167 | BEGIN | |
168 | ErrorString (InitString (a)) | |
169 | END ErrorArray ; | |
170 | ||
171 | ||
172 | (* | |
173 | checkParameterAttribute - | |
174 | *) | |
175 | ||
176 | PROCEDURE checkParameterAttribute ; | |
177 | BEGIN | |
178 | IF makeKey ("unused") # curident | |
179 | THEN | |
180 | metaError1 ('attribute {%1k} is not allowed in the formal parameter section, currently only unused is allowed', curident) | |
181 | END | |
182 | END checkParameterAttribute ; | |
183 | ||
184 | ||
185 | (* | |
186 | checkReturnAttribute - | |
187 | *) | |
188 | ||
189 | PROCEDURE checkReturnAttribute ; | |
190 | BEGIN | |
191 | IF makeKey ("noreturn") # curident | |
192 | THEN | |
193 | metaError1 ('attribute {%1k} is not allowed in the procedure return type, only noreturn is allowed', curident) | |
194 | END | |
195 | END checkReturnAttribute ; | |
196 | ||
197 | ||
198 | (* | |
199 | pushNunbounded - | |
200 | *) | |
201 | ||
202 | PROCEDURE pushNunbounded (c: CARDINAL) ; | |
203 | VAR | |
204 | type, | |
205 | array, | |
206 | subrange: node ; | |
207 | BEGIN | |
208 | WHILE c#0 DO | |
209 | type := pop () ; | |
210 | subrange := makeSubrange (NIL, NIL) ; | |
211 | putSubrangeType (subrange, getCardinal ()) ; | |
212 | ||
213 | array := makeArray (subrange, type) ; | |
214 | putUnbounded (array) ; | |
215 | type := push (array) ; | |
216 | DEC (c) | |
217 | END | |
218 | END pushNunbounded ; | |
219 | ||
220 | ||
221 | (* | |
222 | makeIndexedArray - builds and returns an array of type, t, with, c, indices. | |
223 | *) | |
224 | ||
225 | PROCEDURE makeIndexedArray (c: CARDINAL; t: node) : node ; | |
226 | VAR | |
227 | i: node ; | |
228 | BEGIN | |
229 | WHILE c>0 DO | |
230 | t := makeArray (pop (), t) ; | |
231 | DEC (c) | |
232 | END ; | |
233 | RETURN t | |
234 | END makeIndexedArray ; | |
235 | ||
236 | ||
237 | (* | |
238 | importInto - from, m, import, name, into module, current. | |
239 | It checks to see if curident is an enumeration type | |
240 | and if so automatically includes all enumeration fields | |
241 | as well. | |
242 | *) | |
243 | ||
244 | PROCEDURE importInto (m: node; name: Name; current: node) ; | |
245 | VAR | |
246 | s, o: node ; | |
247 | BEGIN | |
248 | assert (isDef (m)) ; | |
249 | assert (isDef (current) OR isModule (current) OR isImp (current)) ; | |
250 | s := lookupExported (m, name) ; | |
251 | IF s=NIL | |
252 | THEN | |
253 | metaError2 ('{%1k} was not exported from definition module {%2a}', name, m) | |
254 | ELSE | |
255 | o := import (current, s) ; | |
256 | IF s#o | |
257 | THEN | |
258 | metaError2 ('{%1ad} cannot be imported into the current module as it causes a name clash with {%2ad}', | |
259 | s, o) | |
260 | END | |
261 | END | |
262 | END importInto ; | |
263 | ||
264 | ||
265 | (* | |
266 | checkEndName - if module does not have, name, then issue an error containing, desc. | |
267 | *) | |
268 | ||
269 | PROCEDURE checkEndName (module: node; name: Name; desc: ARRAY OF CHAR) ; | |
270 | VAR | |
271 | s: String ; | |
272 | BEGIN | |
273 | IF getSymName (module)#name | |
274 | THEN | |
275 | s := InitString ('inconsistent module name found with this ') ; | |
276 | s := ConCat (s, Mark (InitString (desc))) ; | |
277 | ErrorString (s) | |
278 | END | |
279 | END checkEndName ; | |
280 | ||
281 | % declaration mcp3 begin | |
282 | ||
283 | ||
284 | (* | |
285 | SyntaxError - after a syntax error we skip all tokens up until we reach | |
286 | a stop symbol. | |
287 | *) | |
288 | ||
289 | PROCEDURE SyntaxError (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
290 | BEGIN | |
291 | DescribeError ; | |
292 | IF Debugging | |
293 | THEN | |
294 | printf0('\nskipping token *** ') | |
295 | END ; | |
296 | (* | |
297 | yes the ORD(currenttoken) looks ugly, but it is *much* safer than | |
298 | using currenttoken<sometok as a change to the ordering of the | |
299 | token declarations below would cause this to break. Using ORD() we are | |
300 | immune from such changes | |
301 | *) | |
302 | WHILE NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR | |
303 | ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR | |
304 | ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2))) | |
305 | DO | |
306 | getToken | |
307 | END ; | |
308 | IF Debugging | |
309 | THEN | |
310 | printf0(' ***\n') | |
311 | END | |
312 | END SyntaxError ; | |
313 | ||
314 | ||
315 | (* | |
316 | SyntaxCheck - | |
317 | *) | |
318 | ||
319 | PROCEDURE SyntaxCheck (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
320 | BEGIN | |
321 | (* and again (see above re: ORD) | |
322 | *) | |
323 | IF NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR | |
324 | ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR | |
325 | ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2))) | |
326 | THEN | |
327 | SyntaxError (stopset0, stopset1, stopset2) | |
328 | END | |
329 | END SyntaxCheck ; | |
330 | ||
331 | ||
332 | (* | |
333 | WarnMissingToken - generates a warning message about a missing token, t. | |
334 | *) | |
335 | ||
336 | PROCEDURE WarnMissingToken (t: toktype) ; | |
337 | VAR | |
338 | s0 : SetOfStop0 ; | |
339 | s1 : SetOfStop1 ; | |
340 | s2 : SetOfStop2 ; | |
341 | str: String ; | |
342 | BEGIN | |
343 | s0 := SetOfStop0{} ; | |
344 | s1 := SetOfStop1{} ; | |
345 | s2 := SetOfStop2{} ; | |
346 | IF ORD(t)<32 | |
347 | THEN | |
348 | s0 := SetOfStop0{t} | |
349 | ELSIF ORD(t)<64 | |
350 | THEN | |
351 | s1 := SetOfStop1{t} | |
352 | ELSE | |
353 | s2 := SetOfStop2{t} | |
354 | END ; | |
355 | str := DescribeStop (s0, s1, s2) ; | |
356 | ||
357 | str := ConCat (InitString ('syntax error,'), Mark (str)) ; | |
358 | errorStringAt (str, getTokenNo ()) | |
359 | END WarnMissingToken ; | |
360 | ||
361 | ||
362 | (* | |
363 | MissingToken - generates a warning message about a missing token, t. | |
364 | *) | |
365 | ||
366 | PROCEDURE MissingToken (t: toktype) ; | |
367 | BEGIN | |
368 | WarnMissingToken (t) ; | |
369 | IF (t#identtok) AND (t#integertok) AND (t#realtok) AND (t#stringtok) | |
370 | THEN | |
371 | IF Debugging | |
372 | THEN | |
373 | printf0 ('inserting token\n') | |
374 | END ; | |
375 | insertToken (t) | |
376 | END | |
377 | END MissingToken ; | |
378 | ||
379 | ||
380 | (* | |
381 | CheckAndInsert - | |
382 | *) | |
383 | ||
384 | PROCEDURE CheckAndInsert (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ; | |
385 | BEGIN | |
386 | IF ((ORD(t)<32) AND (t IN stopset0)) OR | |
387 | ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR | |
388 | ((ORD(t)>=64) AND (t IN stopset2)) | |
389 | THEN | |
390 | WarnMissingToken (t) ; | |
391 | insertTokenAndRewind (t) ; | |
392 | RETURN( TRUE ) | |
393 | ELSE | |
394 | RETURN( FALSE ) | |
395 | END | |
396 | END CheckAndInsert ; | |
397 | ||
398 | ||
399 | (* | |
400 | InStopSet | |
401 | *) | |
402 | ||
403 | PROCEDURE InStopSet (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) : BOOLEAN ; | |
404 | BEGIN | |
405 | IF ((ORD(t)<32) AND (t IN stopset0)) OR | |
406 | ((ORD(t)>=32) AND (ORD(t)<64) AND (t IN stopset1)) OR | |
407 | ((ORD(t)>=64) AND (t IN stopset2)) | |
408 | THEN | |
409 | RETURN( TRUE ) | |
410 | ELSE | |
411 | RETURN( FALSE ) | |
412 | END | |
413 | END InStopSet ; | |
414 | ||
415 | ||
416 | (* | |
417 | PeepToken - peep token checks to see whether the stopset is satisfied by currenttoken | |
418 | If it is not then it will insert a token providing the token | |
419 | is one of ; ] ) } . OF END , | |
420 | ||
421 | if the stopset contains <identtok> then we do not insert a token | |
422 | *) | |
423 | ||
424 | PROCEDURE PeepToken (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
425 | BEGIN | |
426 | (* and again (see above re: ORD) | |
427 | *) | |
428 | IF (NOT (((ORD(currenttoken)<32) AND (currenttoken IN stopset0)) OR | |
429 | ((ORD(currenttoken)>=32) AND (ORD(currenttoken)<64) AND (currenttoken IN stopset1)) OR | |
430 | ((ORD(currenttoken)>=64) AND (currenttoken IN stopset2)))) AND | |
431 | (NOT InStopSet(identtok, stopset0, stopset1, stopset2)) | |
432 | THEN | |
433 | (* SyntaxCheck would fail since currentoken is not part of the stopset | |
434 | we check to see whether any of currenttoken might be a commonly omitted token *) | |
435 | IF CheckAndInsert(semicolontok, stopset0, stopset1, stopset2) OR | |
436 | CheckAndInsert(rsbratok, stopset0, stopset1, stopset2) OR | |
437 | CheckAndInsert(rparatok, stopset0, stopset1, stopset2) OR | |
438 | CheckAndInsert(rcbratok, stopset0, stopset1, stopset2) OR | |
439 | CheckAndInsert(periodtok, stopset0, stopset1, stopset2) OR | |
440 | CheckAndInsert(oftok, stopset0, stopset1, stopset2) OR | |
441 | CheckAndInsert(endtok, stopset0, stopset1, stopset2) OR | |
442 | CheckAndInsert(commatok, stopset0, stopset1, stopset2) | |
443 | THEN | |
444 | END | |
445 | END | |
446 | END PeepToken ; | |
447 | ||
448 | ||
449 | (* | |
450 | Expect - | |
451 | *) | |
452 | ||
453 | PROCEDURE Expect (t: toktype; stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
454 | BEGIN | |
455 | IF currenttoken=t | |
456 | THEN | |
457 | getToken ; | |
458 | IF Pass1 | |
459 | THEN | |
460 | PeepToken(stopset0, stopset1, stopset2) | |
461 | END | |
462 | ELSE | |
463 | MissingToken(t) | |
464 | END ; | |
465 | SyntaxCheck(stopset0, stopset1, stopset2) | |
466 | END Expect ; | |
467 | ||
468 | ||
469 | (* | |
470 | CompilationUnit - returns TRUE if the input was correct enough to parse | |
471 | in future passes. | |
472 | *) | |
473 | ||
474 | PROCEDURE CompilationUnit () : BOOLEAN ; | |
475 | BEGIN | |
476 | stk := mcStack.init () ; | |
477 | WasNoError := TRUE ; | |
478 | FileUnit(SetOfStop0{eoftok}, SetOfStop1{}, SetOfStop2{}) ; | |
479 | mcStack.kill (stk) ; | |
480 | RETURN WasNoError | |
481 | END CompilationUnit ; | |
482 | ||
483 | ||
484 | (* | |
485 | Ident - error checking varient of Ident | |
486 | *) | |
487 | ||
488 | PROCEDURE Ident (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
489 | BEGIN | |
490 | curident := makekey (currentstring) ; | |
491 | Expect(identtok, stopset0, stopset1, stopset2) | |
492 | END Ident ; | |
493 | ||
494 | ||
495 | (* | |
496 | string - | |
497 | *) | |
498 | ||
499 | PROCEDURE string (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
500 | BEGIN | |
501 | curstring := makekey (currentstring) ; | |
502 | Expect(stringtok, stopset0, stopset1, stopset2) | |
503 | END string ; | |
504 | ||
505 | ||
506 | (* | |
507 | Integer - | |
508 | *) | |
509 | ||
510 | PROCEDURE Integer (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
511 | BEGIN | |
512 | Expect(integertok, stopset0, stopset1, stopset2) | |
513 | END Integer ; | |
514 | ||
515 | ||
516 | (* | |
517 | Real - | |
518 | *) | |
519 | ||
520 | PROCEDURE Real (stopset0: SetOfStop0; stopset1: SetOfStop1; stopset2: SetOfStop2) ; | |
521 | BEGIN | |
522 | Expect(realtok, stopset0, stopset1, stopset2) | |
523 | END Real ; | |
524 | ||
525 | % module mcp3 end | |
526 | END mcp3. | |
527 | % rules | |
528 | error 'ErrorArray' 'ErrorString' | |
529 | tokenfunc 'currenttoken' | |
530 | ||
531 | token '' eoftok -- internal token | |
532 | token '+' plustok | |
533 | token '-' minustok | |
534 | token '*' timestok | |
535 | token '/' dividetok | |
536 | token ':=' becomestok | |
537 | token '&' ambersandtok | |
538 | token "." periodtok | |
539 | token "," commatok | |
540 | token ";" semicolontok | |
541 | token '(' lparatok | |
542 | token ')' rparatok | |
543 | token '[' lsbratok -- left square brackets | |
544 | token ']' rsbratok -- right square brackets | |
545 | token '{' lcbratok -- left curly brackets | |
546 | token '}' rcbratok -- right curly brackets | |
547 | token '^' uparrowtok | |
548 | token "'" singlequotetok | |
549 | token '=' equaltok | |
550 | token '#' hashtok | |
551 | token '<' lesstok | |
552 | token '>' greatertok | |
553 | token '<>' lessgreatertok | |
554 | token '<=' lessequaltok | |
555 | token '>=' greaterequaltok | |
556 | token '<*' ldirectivetok | |
557 | token '*>' rdirectivetok | |
558 | token '..' periodperiodtok | |
559 | token ':' colontok | |
560 | token '"' doublequotestok | |
561 | token '|' bartok | |
562 | token 'AND' andtok | |
563 | token 'ARRAY' arraytok | |
564 | token 'BEGIN' begintok | |
565 | token 'BY' bytok | |
566 | token 'CASE' casetok | |
567 | token 'CONST' consttok | |
568 | token 'DEFINITION' definitiontok | |
569 | token 'DIV' divtok | |
570 | token 'DO' dotok | |
571 | token 'ELSE' elsetok | |
572 | token 'ELSIF' elsiftok | |
573 | token 'END' endtok | |
574 | token 'EXCEPT' excepttok | |
575 | token 'EXIT' exittok | |
576 | token 'EXPORT' exporttok | |
577 | token 'FINALLY' finallytok | |
578 | token 'FOR' fortok | |
579 | token 'FROM' fromtok | |
580 | token 'IF' iftok | |
581 | token 'IMPLEMENTATION' implementationtok | |
582 | token 'IMPORT' importtok | |
583 | token 'IN' intok | |
584 | token 'LOOP' looptok | |
585 | token 'MOD' modtok | |
586 | token 'MODULE' moduletok | |
587 | token 'NOT' nottok | |
588 | token 'OF' oftok | |
589 | token 'OR' ortok | |
590 | token 'PACKEDSET' packedsettok | |
591 | token 'POINTER' pointertok | |
592 | token 'PROCEDURE' proceduretok | |
593 | token 'QUALIFIED' qualifiedtok | |
594 | token 'UNQUALIFIED' unqualifiedtok | |
595 | token 'RECORD' recordtok | |
596 | token 'REM' remtok | |
597 | token 'REPEAT' repeattok | |
598 | token 'RETRY' retrytok | |
599 | token 'RETURN' returntok | |
600 | token 'SET' settok | |
601 | token 'THEN' thentok | |
602 | token 'TO' totok | |
603 | token 'TYPE' typetok | |
604 | token 'UNTIL' untiltok | |
605 | token 'VAR' vartok | |
606 | token 'WHILE' whiletok | |
607 | token 'WITH' withtok | |
608 | token 'ASM' asmtok | |
609 | token 'VOLATILE' volatiletok | |
610 | token '...' periodperiodperiodtok | |
611 | token '__DATE__' datetok | |
612 | token '__LINE__' linetok | |
613 | token '__FILE__' filetok | |
614 | token '__ATTRIBUTE__' attributetok | |
615 | token '__BUILTIN__' builtintok | |
616 | token '__INLINE__' inlinetok | |
617 | token 'integer number' integertok | |
618 | token 'identifier' identtok | |
619 | token 'real number' realtok | |
620 | token 'string' stringtok | |
621 | ||
622 | special Ident first { < identtok > } follow { } | |
623 | special Integer first { < integertok > } follow { } | |
624 | special Real first { < realtok > } follow { } | |
625 | special string first { < stringtok > } follow { } | |
626 | ||
627 | BNF | |
628 | ||
629 | -- the following are provided by the module m2flex and also handbuild procedures below | |
630 | -- Ident := Letter { ( Letter | Digit ) } =: | |
631 | -- Integer := Digit { Digit } | OctalDigit { OctalDigit } ( " B " | " C " ) | | |
632 | -- Digit { HexDigit } " H " =: | |
633 | -- Real := Digit { Digit } " . " { Digit } [ ScaleFactor ] =: | |
634 | -- ScaleFactor := " E " [ ( " + " | " - " ) ] Digit { Digit } =: | |
635 | -- HexDigit := Digit | " A " | " B " | " C " | " D " | " E " | " F " =: | |
636 | -- Digit := OctalDigit | " 8 " | " 9 " =: | |
637 | -- OctalDigit := "0" | "1" | "2" | "3" | "4" | "5" | "6" | "7" =: | |
638 | -- String | |
639 | ||
640 | FileUnit := DefinitionModule | ImplementationOrProgramModule | |
641 | =: | |
642 | ||
643 | ProgramModule := "MODULE" | |
644 | Ident % curmodule := lookupModule (curident) % | |
645 | % enterScope (curmodule) % | |
646 | % resetEnumPos (curmodule) % | |
647 | [ Priority | |
648 | ] | |
649 | ";" | |
650 | { Import } | |
651 | Block | |
652 | Ident % checkEndName (curmodule, curident, 'program module') % | |
653 | % setConstExpComplete (curmodule) % | |
654 | % leaveScope % | |
655 | ||
656 | "." | |
657 | =: | |
658 | ||
659 | ImplementationModule := "IMPLEMENTATION" "MODULE" | |
660 | Ident % curmodule := lookupImp (curident) % | |
661 | % enterScope (lookupDef (curident)) % | |
662 | % enterScope (curmodule) % | |
663 | % resetEnumPos (curmodule) % | |
664 | [ Priority | |
665 | ] ";" | |
666 | { Import } | |
667 | Block | |
668 | Ident % checkEndName (curmodule, curident, 'implementation module') % | |
669 | % setConstExpComplete (curmodule) % | |
670 | % leaveScope ; leaveScope % | |
671 | "." | |
672 | =: | |
673 | ||
674 | ImplementationOrProgramModule := ImplementationModule | ProgramModule | |
675 | =: | |
676 | ||
677 | Number := Integer | Real =: | |
678 | ||
679 | Qualident := | |
680 | Ident { "." Ident } | |
681 | =: | |
682 | ||
683 | ConstantDeclaration := % VAR d, e: node ; % | |
684 | Ident % d := lookupSym (curident) % | |
685 | "=" ConstExpression % e := pop () % | |
686 | % assert (isConst (d)) % | |
687 | % putConst (d, e) % | |
688 | =: | |
689 | ||
690 | ConstExpressionNop := SimpleConstExpr % VAR n: node ; % | |
691 | [ Relation SimpleConstExpr ] | |
692 | % n := makeConstExp () % | |
693 | =: | |
694 | ||
695 | ConstExpression := % VAR n: node ; % | |
696 | % n := push (makeConstExp ()) % | |
697 | SimpleConstExpr | |
698 | [ Relation SimpleConstExpr ] | |
699 | =: | |
700 | ||
701 | Relation := "=" | |
702 | | "#" | |
703 | | "<>" | |
704 | | "<" | |
705 | | "<=" | |
706 | | ">" | |
707 | | ">=" | |
708 | | "IN" | |
709 | =: | |
710 | ||
711 | SimpleConstExpr := UnaryOrConstTerm { AddOperator ConstTerm } =: | |
712 | ||
713 | UnaryOrConstTerm := "+" ConstTerm | "-" ConstTerm | ConstTerm =: | |
714 | ||
715 | AddOperator := "+" | "-" | "OR" =: | |
716 | ||
717 | ConstTerm := ConstFactor { MulOperator ConstFactor } =: | |
718 | ||
719 | MulOperator := "*" | |
720 | | "/" | |
721 | | "DIV" | |
722 | | "MOD" | |
723 | | "REM" | |
724 | | "AND" | |
725 | | "&" | |
726 | =: | |
727 | ||
728 | ConstFactor := Number | ConstString | ConstSetOrQualidentOrFunction | | |
729 | "(" ConstExpressionNop ")" | "NOT" ConstFactor | |
730 | | ConstAttribute =: | |
731 | ||
732 | -- to help satisfy LL1 | |
733 | ||
734 | ConstString := string =: | |
735 | ||
736 | ComponentElement := ConstExpressionNop [ ".." ConstExpressionNop ] =: | |
737 | ||
738 | ComponentValue := ComponentElement [ 'BY' ConstExpressionNop ] =: | |
739 | ||
740 | ArraySetRecordValue := ComponentValue { ',' ComponentValue } =: | |
741 | ||
742 | Constructor := '{'[ ArraySetRecordValue ] '}' =: | |
743 | ||
744 | ConstSetOrQualidentOrFunction := Qualident | |
745 | [ Constructor | | |
746 | ConstActualParameters | |
747 | ] | Constructor =: | |
748 | ||
749 | ConstActualParameters := "(" [ ConstExpList ] ")" =: | |
750 | ||
751 | ConstExpList := ConstExpressionNop { "," ConstExpressionNop } =: | |
752 | ||
753 | ConstAttribute := "__ATTRIBUTE__" "__BUILTIN__" "(" "(" | |
754 | ConstAttributeExpression | |
755 | ")" ")" =: | |
756 | ||
757 | ConstAttributeExpression := Ident | "<" Qualident ',' Ident ">" =: | |
758 | ||
759 | ByteAlignment := '<*' AttributeExpression '*>' =: | |
760 | ||
761 | OptAlignmentExpression := [ AlignmentExpression ] =: | |
762 | ||
763 | AlignmentExpression := "(" ConstExpressionNop ")" =: | |
764 | ||
765 | Alignment := [ ByteAlignment ] =: | |
766 | ||
767 | IdentList := Ident { "," Ident } | |
768 | =: | |
769 | ||
770 | PushIdentList := % VAR n: node ; % | |
771 | % n := makeIdentList () % | |
772 | Ident % checkDuplicate (putIdent (n, curident)) % | |
773 | { "," Ident % checkDuplicate (putIdent (n, curident)) % | |
774 | } % n := push (n) % | |
775 | =: | |
776 | ||
777 | SubrangeType := % VAR low, high: node ; d: CARDINAL ; % | |
778 | "[" % d := depth () % | |
779 | ConstExpression % low := pop () % | |
780 | % assert (d = depth ()) % | |
781 | ".." ConstExpression % high := pop () % | |
782 | % assert (d = depth ()) % | |
783 | % typeExp := push (makeSubrange (low, high)) % | |
784 | % assert (d = depth () - 1) % | |
785 | "]" | |
786 | =: | |
787 | ||
788 | ArrayType := "ARRAY" % VAR c: CARDINAL ; t, n: node ; % | |
789 | % c := 0 % | |
790 | SimpleType % INC (c) % | |
791 | { "," | |
792 | SimpleType % INC (c) % | |
793 | } "OF" | |
794 | Type % n := push (makeIndexedArray (c, pop ())) % | |
795 | =: | |
796 | ||
797 | RecordType := "RECORD" % VAR n: node ; % | |
798 | % n := push (makeRecord ()) % | |
799 | % n := push (NIL) (* no varient *) % | |
800 | [ DefaultRecordAttributes ] | |
801 | FieldListSequence % assert (pop ()=NIL) % | |
802 | "END" =: | |
803 | ||
804 | DefaultRecordAttributes := '<*' | |
805 | AttributeExpression | |
806 | ||
807 | '*>' =: | |
808 | ||
809 | RecordFieldPragma := [ '<*' FieldPragmaExpression | |
810 | { ',' FieldPragmaExpression } '*>' ] =: | |
811 | ||
812 | FieldPragmaExpression := Ident PragmaConstExpression =: | |
813 | ||
814 | PragmaConstExpression := [ '(' ConstExpressionNop ')' ] =: | |
815 | ||
816 | AttributeExpression := Ident '(' ConstExpressionNop ')' =: | |
817 | ||
818 | FieldListSequence := FieldListStatement { ";" FieldListStatement } =: | |
819 | ||
820 | FieldListStatement := [ FieldList ] =: | |
821 | ||
822 | FieldList := % VAR r, i, f, t, n, v, w: node ; d: CARDINAL ; % | |
823 | % d := depth () % | |
824 | % v := pop () ; assert ((v=NIL) OR isVarient (v)) % | |
825 | % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % | |
826 | % v := push (v) % | |
827 | % assert (d=depth ()) % | |
828 | % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isVarientField (r))) % | |
829 | PushIdentList ":" % assert (d=depth () - 1) % | |
830 | % i := pop () % | |
831 | Type % assert (d=depth () - 1) % | |
832 | % t := pop () % | |
833 | RecordFieldPragma % assert (d=depth ()) % | |
834 | % r := addFieldsToRecord (r, v, i, t) % | |
835 | % assert (d=depth ()) % | |
836 | | | |
837 | "CASE" % (* addRecordToList *) % | |
838 | % d := depth () % | |
839 | % v := pop () ; assert ((v=NIL) OR isVarient (v)) % | |
840 | % r := peep () ; assert (isRecord (r) OR isVarientField (r)) % | |
841 | % v := push (v) % | |
842 | % assert (((v=NIL) AND isRecord (r)) OR ((v#NIL) AND isRecordField (r))) % | |
843 | % w := push (makeVarient (r)) % | |
844 | % assert (d = depth () - 1) % | |
845 | % (* addVarientToList *) % | |
846 | CaseTag "OF" | |
847 | % assert (d = depth () - 1) % | |
848 | Varient % assert (d = depth () - 1) % | |
849 | { "|" Varient % assert (d = depth () - 1) % | |
850 | } | |
851 | % w := peep () ; assert (isVarient (w)) % | |
852 | % assert (d = depth () - 1) % | |
853 | [ "ELSE" | |
854 | FieldListSequence | |
855 | ] "END" % w := pop () ; assert (isVarient (w)) % | |
856 | % assert (d=depth ()) % | |
857 | =: | |
858 | ||
859 | TagIdent := Ident | % curident := NulName % | |
860 | =: | |
861 | ||
862 | CaseTag := % VAR tagident: Name ; q, v, w, r: node ; % | |
863 | % w := pop () ; v := pop () ; r := peep () ; v := push (v) ; w := push (w) % | |
864 | % assert (isVarient (w)) % | |
865 | % assert ((v=NIL) OR isVarient (v)) % | |
866 | % assert (isRecord (r) OR isVarientField (r)) % | |
867 | % assert (isVarient (push (pop ()))) % | |
868 | TagIdent % tagident := curident % | |
869 | ( ":" PushQualident % q := pop () % | |
870 | % assert (isVarient (push (pop ()))) % | |
871 | | % q := NIL % | |
872 | ) % buildVarientSelector (r, w, tagident, q) % | |
873 | =: | |
874 | ||
875 | Varient := % VAR p, r, v, f: node ; d: CARDINAL ; % | |
876 | % d := depth () % | |
877 | % assert (isVarient (peep ())) % | |
878 | [ % v := pop () ; assert (isVarient (v)) % | |
879 | % r := pop () % | |
880 | % p := peep () % | |
881 | % r := push (r) % | |
882 | % f := push (buildVarientFieldRecord (v, p)) % | |
883 | % v := push (v) % | |
884 | VarientCaseLabelList ":" FieldListSequence % v := pop () % | |
885 | % f := pop () % | |
886 | % assert (isVarientField (f)) % | |
887 | % assert (isVarient (v)) % | |
888 | % v := push (v) % | |
889 | ] % assert (isVarient (peep ())) % | |
890 | % assert (d=depth ()) % | |
891 | =: | |
892 | ||
893 | VarientCaseLabelList := VarientCaseLabels { "," VarientCaseLabels } =: | |
894 | ||
895 | VarientCaseLabels := % VAR l, h: node ; % | |
896 | % h := NIL % | |
897 | ConstExpression % l := pop () % | |
898 | [ ".." ConstExpression % h := pop () % | |
899 | ] % (* l, h could be saved if necessary. *) % | |
900 | =: | |
901 | ||
902 | SetType := ( "SET" | "PACKEDSET" ) "OF" SimpleType % VAR n: node ; % | |
903 | % n := push (makeSet (pop ())) % | |
904 | =: | |
905 | ||
906 | PointerType := "POINTER" "TO" Type % VAR n: node ; % | |
907 | % n := push (makePointer (pop ())) % | |
908 | =: | |
909 | ||
910 | ProcedureType := "PROCEDURE" % curproc := push (makeProcType ()) % | |
911 | [ FormalTypeList ] =: | |
912 | ||
913 | FormalTypeList := "(" ( ")" FormalReturn | | |
914 | ProcedureParameters ")" FormalReturn ) =: | |
915 | ||
916 | FormalReturn := [ ":" OptReturnType ] =: | |
917 | ||
918 | OptReturnType := "[" PushQualident % putReturnType (curproc, pop ()) % | |
919 | % putOptReturn (curproc) % | |
920 | "]" | PushQualident % putReturnType (curproc, pop ()) % | |
921 | =: | |
922 | ||
923 | ProcedureParameters := ProcedureParameter % addParameter (curproc, pop ()) % | |
924 | { "," ProcedureParameter % addParameter (curproc, pop ()) % | |
925 | } =: | |
926 | ||
927 | ProcedureParameter := "..." % VAR n: node ; % | |
928 | % n := push (makeVarargs ()) % | |
929 | | "VAR" FormalType % n := push (makeVarParameter (NIL, pop (), curproc, TRUE)) % | |
930 | | FormalType % n := push (makeNonVarParameter (NIL, pop (), curproc, TRUE)) % | |
931 | =: | |
932 | ||
933 | ||
934 | VarIdent := % VAR n, a: node ; % | |
935 | % n := pop () % | |
936 | Ident % checkDuplicate (putIdent (n, curident)) % | |
937 | % n := push (n) % | |
938 | [ "[" ConstExpression % a := pop () (* could store, a, into, n. *) % | |
939 | "]" ] | |
940 | =: | |
941 | ||
942 | VarIdentList := % VAR n: node ; % | |
943 | % n := makeIdentList () % | |
944 | % n := push (n) % | |
945 | VarIdent { "," VarIdent } | |
946 | =: | |
947 | ||
948 | VariableDeclaration := % VAR v, d: node ; % | |
949 | VarIdentList % v := pop () % | |
950 | ":" Type % d := makeVarDecl (v, pop ()) % | |
951 | Alignment | |
952 | =: | |
953 | ||
954 | Designator := Qualident | |
955 | { SubDesignator } =: | |
956 | ||
957 | SubDesignator := "." | |
958 | Ident | |
959 | | "[" ArrayExpList | |
960 | "]" | |
961 | | "^" | |
962 | =: | |
963 | ||
964 | ArrayExpList := | |
965 | Expression | |
966 | { "," | |
967 | Expression | |
968 | } | |
969 | =: | |
970 | ||
971 | ExpList := Expression { "," Expression } | |
972 | =: | |
973 | ||
974 | Expression := SimpleExpression [ Relation SimpleExpression ] | |
975 | =: | |
976 | ||
977 | SimpleExpression := UnaryOrTerm { AddOperator Term } =: | |
978 | ||
979 | UnaryOrTerm := "+" Term | |
980 | | "-" Term | |
981 | | Term | |
982 | =: | |
983 | ||
984 | Term := Factor { MulOperator Factor | |
985 | } =: | |
986 | ||
987 | Factor := Number | string | SetOrDesignatorOrFunction | | |
988 | "(" Expression ")" | "NOT" ( Factor | |
989 | | ConstAttribute | |
990 | ) =: | |
991 | ||
992 | SetOrDesignatorOrFunction := Qualident | |
993 | [ Constructor | | |
994 | SimpleDes [ ActualParameters ] | |
995 | ] | | |
996 | Constructor =: | |
997 | ||
998 | -- SimpleDes := { "." Ident | "[" ExpList "]" | "^" } =: | |
999 | SimpleDes := { SubDesignator } =: | |
1000 | ||
1001 | ActualParameters := "(" [ ExpList ] ")" =: | |
1002 | ||
1003 | ExitStatement := "EXIT" | |
1004 | =: | |
1005 | ||
1006 | ReturnStatement := "RETURN" [ Expression ] | |
1007 | =: | |
1008 | ||
1009 | Statement := [ AssignmentOrProcedureCall | IfStatement | CaseStatement | | |
1010 | WhileStatement | RepeatStatement | LoopStatement | | |
1011 | ForStatement | WithStatement | AsmStatement | | |
1012 | ExitStatement | ReturnStatement | RetryStatement | |
1013 | ] | |
1014 | =: | |
1015 | ||
1016 | RetryStatement := "RETRY" | |
1017 | =: | |
1018 | ||
1019 | AssignmentOrProcedureCall := Designator | |
1020 | ( ":=" Expression | |
1021 | | | |
1022 | ActualParameters | % (* epsilon *) % | |
1023 | ) | |
1024 | =: | |
1025 | ||
1026 | StatementSequence := Statement { ";" Statement } | |
1027 | =: | |
1028 | ||
1029 | IfStatement := "IF" | |
1030 | Expression "THEN" | |
1031 | StatementSequence | |
1032 | { "ELSIF" | |
1033 | ||
1034 | Expression "THEN" | |
1035 | StatementSequence | |
1036 | } | |
1037 | [ "ELSE" | |
1038 | StatementSequence ] "END" | |
1039 | =: | |
1040 | ||
1041 | CaseStatement := "CASE" | |
1042 | Expression | |
1043 | "OF" Case { "|" Case } | |
1044 | CaseEndStatement | |
1045 | =: | |
1046 | ||
1047 | CaseEndStatement := "END" | |
1048 | | "ELSE" | |
1049 | StatementSequence "END" | |
1050 | =: | |
1051 | ||
1052 | Case := [ CaseLabelList ":" StatementSequence ] | |
1053 | =: | |
1054 | ||
1055 | CaseLabelList := CaseLabels { "," CaseLabels } =: | |
1056 | ||
1057 | CaseLabels := ConstExpressionNop [ ".." ConstExpressionNop ] | |
1058 | =: | |
1059 | ||
1060 | WhileStatement := "WHILE" Expression "DO" | |
1061 | StatementSequence | |
1062 | "END" | |
1063 | =: | |
1064 | ||
1065 | RepeatStatement := "REPEAT" | |
1066 | StatementSequence | |
1067 | "UNTIL" Expression | |
1068 | =: | |
1069 | ||
1070 | ForStatement := "FOR" Ident ":=" Expression "TO" Expression | |
1071 | [ "BY" ConstExpressionNop ] "DO" | |
1072 | StatementSequence | |
1073 | "END" | |
1074 | =: | |
1075 | ||
1076 | LoopStatement := "LOOP" | |
1077 | StatementSequence | |
1078 | "END" | |
1079 | =: | |
1080 | ||
1081 | WithStatement := "WITH" Designator "DO" | |
1082 | StatementSequence | |
1083 | "END" | |
1084 | =: | |
1085 | ||
1086 | ProcedureDeclaration := ProcedureHeading ";" ProcedureBlock | |
1087 | Ident % leaveScope % | |
1088 | =: | |
1089 | ||
1090 | ProcedureIdent := Ident % curproc := lookupSym (curident) % | |
1091 | % enterScope (curproc) % | |
1092 | =: | |
1093 | ||
1094 | DefProcedureIdent := Ident % curproc := lookupSym (curident) % | |
1095 | =: | |
1096 | ||
1097 | DefineBuiltinProcedure := [ "__ATTRIBUTE__" "__BUILTIN__" "(" "(" Ident ")" ")" | "__INLINE__" ] | |
1098 | =: | |
1099 | ||
1100 | ProcedureHeading := "PROCEDURE" DefineBuiltinProcedure ( ProcedureIdent [ FormalParameters ] AttributeNoReturn ) | |
1101 | =: | |
1102 | ||
1103 | Builtin := [ "__BUILTIN__" | "__INLINE__" ] =: | |
1104 | ||
1105 | DefProcedureHeading := "PROCEDURE" Builtin ( DefProcedureIdent [ DefFormalParameters ] AttributeNoReturn ) | |
1106 | =: | |
1107 | ||
1108 | -- introduced procedure block so we can produce more informative | |
1109 | -- error messages | |
1110 | ||
1111 | ProcedureBlock := { Declaration } [ "BEGIN" ProcedureBlockBody ] "END" | |
1112 | =: | |
1113 | ||
1114 | Block := { Declaration } InitialBlock FinalBlock "END" | |
1115 | =: | |
1116 | ||
1117 | InitialBlock := [ "BEGIN" InitialBlockBody ] =: | |
1118 | ||
1119 | FinalBlock := [ "FINALLY" FinalBlockBody ] =: | |
1120 | ||
1121 | InitialBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =: | |
1122 | ||
1123 | FinalBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =: | |
1124 | ||
1125 | ProcedureBlockBody := NormalPart [ "EXCEPT" ExceptionalPart ] =: | |
1126 | ||
1127 | NormalPart := StatementSequence =: | |
1128 | ||
1129 | ExceptionalPart := StatementSequence | |
1130 | =: | |
1131 | ||
1132 | Declaration := "CONST" { ConstantDeclaration ";" } | | |
1133 | "TYPE" { TypeDeclaration } | | |
1134 | "VAR" { VariableDeclaration ";" } | | |
1135 | ProcedureDeclaration ";" | | |
1136 | ModuleDeclaration ";" =: | |
1137 | ||
1138 | DefFormalParameters := "(" % paramEnter (curproc) % | |
1139 | [ DefMultiFPSection ] ")" % paramLeave (curproc) % | |
1140 | FormalReturn =: | |
1141 | ||
1142 | DefMultiFPSection := DefExtendedFP | FPSection [ ";" DefMultiFPSection ] =: | |
1143 | ||
1144 | FormalParameters := "(" % paramEnter (curproc) % | |
1145 | [ MultiFPSection ] ")" % paramLeave (curproc) % | |
1146 | FormalReturn =: | |
1147 | ||
1148 | AttributeNoReturn := [ NoReturn | % setNoReturn (curproc, FALSE) % | |
1149 | ] =: | |
1150 | ||
1151 | NoReturn := "<*" Ident % setNoReturn (curproc, TRUE) % | |
1152 | % checkReturnAttribute % | |
1153 | "*>" =: | |
1154 | ||
1155 | AttributeUnused := [ Unused ] =: | |
1156 | ||
1157 | Unused := "<*" Ident % curisused := FALSE % | |
1158 | % checkParameterAttribute % | |
1159 | "*>" =: | |
1160 | ||
1161 | MultiFPSection := ExtendedFP | FPSection [ ";" MultiFPSection ] =: | |
1162 | ||
1163 | FPSection := NonVarFPSection | VarFPSection =: | |
1164 | ||
1165 | DefExtendedFP := DefOptArg | "..." % addParameter (curproc, makeVarargs ()) % | |
1166 | =: | |
1167 | ||
1168 | ExtendedFP := OptArg | "..." | |
1169 | =: | |
1170 | ||
1171 | VarFPSection := "VAR" PushIdentList % VAR l, t: node ; % | |
1172 | ":" FormalType % t := pop () % | |
1173 | % l := pop () % | |
1174 | % curisused := TRUE % | |
1175 | [ AttributeUnused ] | |
1176 | % addVarParameters (curproc, l, t, curisused) % | |
1177 | =: | |
1178 | ||
1179 | NonVarFPSection := PushIdentList % VAR l, t: node ; % | |
1180 | ":" FormalType % t := pop () % | |
1181 | % l := pop () % | |
1182 | % curisused := TRUE % | |
1183 | [ AttributeUnused ] | |
1184 | % addNonVarParameters (curproc, l, t, curisused) % | |
1185 | =: | |
1186 | ||
1187 | OptArg := % VAR p, init, type: node ; id: Name ; % | |
1188 | "[" Ident % id := curident % | |
1189 | ":" FormalType % type := pop () % | |
1190 | % init := NIL % | |
1191 | [ "=" ConstExpression % init := pop () % | |
1192 | ] "]" % p := addOptParameter (curproc, id, type, init) % | |
1193 | =: | |
1194 | ||
1195 | ||
1196 | DefOptArg := % VAR p, init, type: node ; id: Name ; % | |
1197 | "[" Ident % id := curident % | |
1198 | ":" FormalType % type := pop () % | |
1199 | "=" ConstExpression % init := pop () % | |
1200 | "]" % p := addOptParameter (curproc, id, type, init) % | |
1201 | =: | |
1202 | ||
1203 | ||
1204 | FormalType := % VAR c: CARDINAL ; % | |
1205 | % VAR n, a, s: node ; % | |
1206 | % c := 0 % | |
1207 | { "ARRAY" "OF" % INC (c) % | |
1208 | } PushQualident % pushNunbounded (c) % | |
1209 | =: | |
1210 | ||
1211 | ModuleDeclaration := "MODULE" Ident [ Priority ] ";" | |
1212 | { Import } [ Export ] | |
1213 | Block Ident | |
1214 | =: | |
1215 | ||
1216 | Priority := "[" ConstExpressionNop "]" =: | |
1217 | ||
1218 | Export := "EXPORT" ( "QUALIFIED" | |
1219 | IdentList | | |
1220 | "UNQUALIFIED" | |
1221 | IdentList | | |
1222 | IdentList ) ";" =: | |
1223 | ||
1224 | FromIdentList := Ident % importInto (frommodule, curident, curmodule) % | |
1225 | { "," Ident % importInto (frommodule, curident, curmodule) % | |
1226 | } | |
1227 | =: | |
1228 | ||
1229 | FromImport := "FROM" Ident % frommodule := lookupDef (curident) % | |
1230 | "IMPORT" FromIdentList ";" | |
1231 | =: | |
1232 | ||
1233 | ImportModuleList := Ident { "," Ident } =: | |
1234 | ||
1235 | WithoutFromImport := "IMPORT" ImportModuleList ";" | |
1236 | =: | |
1237 | ||
1238 | Import := FromImport | WithoutFromImport =: | |
1239 | ||
1240 | DefinitionModule := "DEFINITION" "MODULE" [ "FOR" string ] Ident ";" % curmodule := lookupDef (curident) % | |
1241 | % enterScope (curmodule) % | |
1242 | % resetEnumPos (curmodule) % | |
1243 | { Import } [ Export ] | |
1244 | { Definition } | |
1245 | "END" Ident "." % checkEndName (curmodule, curident, 'definition module') % | |
1246 | % setConstExpComplete (curmodule) % | |
1247 | % leaveScope % | |
1248 | =: | |
1249 | ||
1250 | PushQualident := | |
1251 | Ident % typeExp := push (lookupSym (curident)) % | |
1252 | % IF typeExp = NIL | |
1253 | THEN | |
1254 | metaError1 ('the symbol {%1k} is not visible in this scope (or any other nested scope)', curident) | |
1255 | END % | |
1256 | [ "." | |
1257 | % IF NOT isDef (typeExp) | |
1258 | THEN | |
1259 | ErrorArray ('the first component of this qualident must be a definition module') | |
1260 | END % | |
1261 | Ident % typeExp := replace (lookupInScope (typeExp, curident)) ; | |
1262 | IF typeExp=NIL | |
1263 | THEN | |
1264 | ErrorArray ('identifier not found in definition module') | |
1265 | END % | |
1266 | ] | |
1267 | =: | |
1268 | ||
1269 | OptSubrange := [ SubrangeType | |
1270 | % VAR q, s: node ; % | |
1271 | % s := pop () % | |
1272 | % q := pop () % | |
1273 | % putSubrangeType (s, q) % | |
1274 | % typeExp := push (s) % | |
1275 | ] | |
1276 | =: | |
1277 | ||
1278 | TypeEquiv := PushQualident OptSubrange =: | |
1279 | ||
1280 | EnumIdentList := % VAR f: node ; % | |
1281 | % typeExp := push (makeEnum ()) % | |
1282 | Ident % f := makeEnumField (typeExp, curident) % | |
1283 | { "," Ident % f := makeEnumField (typeExp, curident) % | |
1284 | } | |
1285 | =: | |
1286 | ||
1287 | Enumeration := "(" EnumIdentList ")" =: | |
1288 | ||
1289 | SimpleType := % VAR d: CARDINAL ; % | |
1290 | % d := depth () % | |
1291 | ( TypeEquiv | Enumeration | SubrangeType ) % assert (d = depth () - 1) % | |
1292 | =: | |
1293 | ||
1294 | Type := SimpleType | ArrayType | RecordType | SetType | | |
1295 | PointerType | ProcedureType | |
1296 | =: | |
1297 | ||
1298 | TypeDeclaration := { Ident % typeDes := lookupSym (curident) % | |
1299 | ( ";" | "=" Type % putType (typeDes, pop ()) % | |
1300 | Alignment ";" ) } | |
1301 | =: | |
1302 | ||
1303 | Definition := "CONST" { ConstantDeclaration ";" } | | |
1304 | "TYPE" { TypeDeclaration } | | |
1305 | "VAR" { VariableDeclaration ";" } | | |
1306 | DefProcedureHeading ";" =: | |
1307 | ||
1308 | AsmStatement := 'ASM' [ 'VOLATILE' ] '(' AsmOperands ')' =: | |
1309 | ||
1310 | AsmOperands := string [ AsmOperandSpec ] | |
1311 | =: | |
1312 | ||
1313 | AsmOperandSpec := [ ':' AsmList [ ':' AsmList [ ':' TrashList ] ] ] | |
1314 | =: | |
1315 | ||
1316 | AsmList := [ AsmElement ] { ',' AsmElement } =: | |
1317 | ||
1318 | NamedOperand := '[' Ident ']' =: | |
1319 | ||
1320 | AsmOperandName := [ NamedOperand ] | |
1321 | =: | |
1322 | ||
1323 | AsmElement := AsmOperandName string '(' Expression ')' | |
1324 | =: | |
1325 | ||
1326 | TrashList := [ string ] { ',' string } =: | |
1327 | ||
1328 | FNB |