DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / gpcp-linux.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
Remove batch
[gpcp-linux.git] / gpcp / CPascalP.cp
1 (* ==================================================================== *)
2 (* *)
3 (* Parser Module for the Gardens Point Component Pascal Compiler. *)
4 (* Copyright (c) John Gough 1999, 2000. *)
5 (* This module was extensively modified from the parser *)
6 (* automatically produced by the M2 version of COCO/R, using *)
7 (* the CPascal.atg grammar used for the JVM version of GPCP. *)
8 (* *)
9 (* ==================================================================== *)
10
11 MODULE CPascalP;
12
13 IMPORT
14 GPCPcopyright,
15 RTS,
16 FileNames,
17 ForeignName,
18 LitValue,
19 C := Console,
20 T := CPascalG,
21 S := CPascalS,
22 Cs := CompState,
23 Sy := Symbols,
24 Id := IdDesc,
25 Ty := TypeDesc,
26 Xp := ExprDesc,
27 Bi := Builtin,
28 StatDesc,
29 Visitor,
30 OldSymFileRW,
31 NewSymFileRW,
32 NameHash;
33
34 (* ==================================================================== *)
35
36 CONST
37 maxT = 85;
38 minErrDist = 2; (* minimal distance (good tokens) between two errors *)
39 setsize = 32;
40 noError = -1;
41
42 TYPE
43 SymbolSet = ARRAY (maxT DIV setsize + 1) OF SET; (* 0 .. 2 *)
44
45 VAR
46 symSet : ARRAY 13 OF SymbolSet; (*symSet[0] = allSyncSyms*)
47 errDist : INTEGER; (* number of symbols recognized since last error *)
48 token : S.Token; (* current input symbol *)
49 nextT : S.Token; (* lookahead input symbol *)
50 comma : LitValue.CharOpen;
51
52 (* ==================================================================== *)
53 (* Utilities *)
54 (* ==================================================================== *)
55
56 PROCEDURE Error (errNo: INTEGER);
57 BEGIN
58 IF errDist >= minErrDist THEN
59 S.ParseErr.Report(errNo, nextT.lin, nextT.col);
60 END;
61 IF errNo < 300 THEN errDist := 0 END;
62 END Error;
63
64 (* ==================================================================== *)
65
66 PROCEDURE SemError(errNo: INTEGER);
67 BEGIN
68 IF errDist >= minErrDist THEN
69 S.SemError.Report(errNo, token.lin, token.col);
70 END;
71 IF errNo < 300 THEN errDist := 0 END;
72 END SemError;
73
74 (* ==================================================================== *)
75
76 PROCEDURE SemErrorS1(errNo: INTEGER; IN str : ARRAY OF CHAR);
77 BEGIN
78 IF errDist >= minErrDist THEN
79 S.SemError.RepSt1(errNo, str, token.lin, token.col);
80 END;
81 IF errNo < 300 THEN errDist := 0 END;
82 END SemErrorS1;
83
84 (* ==================================================================== *)
85
86 PROCEDURE SemErrorT(errNo: INTEGER; tok : S.Token);
87 BEGIN
88 IF errDist >= minErrDist THEN
89 S.SemError.Report(errNo, tok.lin, tok.col);
90 END;
91 IF errNo < 300 THEN errDist := 0 END;
92 END SemErrorT;
93
94 (* ==================================================================== *)
95
96 PROCEDURE TypeResolve(scp : Sy.Scope);
97 BEGIN
98 (*
99 * This visitor marks all reachable types with depth=REACHED;
100 *)
101 scp.symTb.Apply(Visitor.newResolver());
102 END TypeResolve;
103
104 (* ==================================================================== *)
105
106 PROCEDURE bindToken(scp : Sy.Scope) : Sy.Idnt;
107 VAR hash : INTEGER;
108 BEGIN
109 hash := NameHash.enterSubStr(token.pos, token.len);
110 RETURN Sy.bind(hash, scp);
111 END bindToken;
112
113 (* ==================================================================== *)
114
115 PROCEDURE bindFieldToken(typ : Sy.Type; tok : S.Token) : Sy.Idnt;
116 VAR hash : INTEGER;
117 recT : Ty.Record;
118 idnt : Sy.Idnt;
119 BEGIN
120 (*
121 * We must do a full bind here, rather than just a bind-local
122 * since we must look for inherited methods from the supertypes
123 *)
124 hash := NameHash.enterSubStr(tok.pos, tok.len);
125 WITH typ : Ty.Record DO
126 RETURN typ.bindField(hash);
127 | typ : Ty.Enum DO
128 RETURN typ.symTb.lookup(hash);
129 END;
130 END bindFieldToken;
131
132 (* ==================================================================== *)
133
134 PROCEDURE bindTokenLocal(scp : Sy.Scope) : Sy.Idnt;
135 VAR hash : INTEGER;
136 BEGIN
137 hash := NameHash.enterSubStr(token.pos, token.len);
138 RETURN Sy.bindLocal(hash, scp);
139 END bindTokenLocal;
140
141 (* ==================================================================== *)
142
143 PROCEDURE Get;
144 BEGIN
145 REPEAT
146 token := nextT;
147 nextT := S.get();
148 IF nextT.sym <= maxT THEN INC(errDist) ELSE Error(91) END;
149 UNTIL nextT.sym <= maxT;
150 S.prevTok := token;
151 END Get;
152
153 (* ==================================================================== *)
154
155 PROCEDURE in (VAR s: SymbolSet; x: INTEGER): BOOLEAN;
156 BEGIN
157 RETURN x MOD setsize IN s[x DIV setsize];
158 END in;
159
160 (* ==================================================================== *)
161
162 PROCEDURE Expect (n: INTEGER);
163 BEGIN
164 IF nextT.sym = n THEN Get ELSE Error(n) END;
165 END Expect;
166
167 (* ==================================================================== *)
168
169 PROCEDURE weakSeparator (n, syFol, repFol: INTEGER): BOOLEAN;
170 VAR
171 s: SymbolSet;
172 i: INTEGER;
173 BEGIN
174 IF nextT.sym = n THEN Get; RETURN TRUE
175 ELSIF in(symSet[repFol], nextT.sym) THEN RETURN FALSE
176 ELSE
177 FOR i := 0 TO maxT DIV setsize DO
178 s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i];
179 END;
180 Error(n); WHILE ~ in(s, nextT.sym) DO Get END;
181 RETURN in(symSet[syFol], nextT.sym)
182 END
183 END weakSeparator;
184
185 (* ==================================================================== *)
186 (* Forward Procedure Declarations *)
187 (* ==================================================================== *)
188
189 PROCEDURE^ ActualParameters(VAR rslt : Sy.ExprSeq; inhScp : Sy.Scope);
190 PROCEDURE^ ImportList (modScope : Id.BlkId);
191 PROCEDURE^ DeclarationSequence (defScp : Sy.Scope);
192 PROCEDURE^ ConstantDeclaration (defScp : Sy.Scope);
193 PROCEDURE^ TypeDeclaration(defScp : Sy.Scope);
194 PROCEDURE^ VariableDeclaration(defScp : Sy.Scope);
195 PROCEDURE^ IdentDefList(OUT iSeq : Sy.IdSeq; scp : Sy.Scope; kind : INTEGER);
196 PROCEDURE^ typeQualid(defScp : Sy.Scope) : Id.TypId;
197 PROCEDURE^ qualident(defScp : Sy.Scope) : Sy.Idnt;
198 PROCEDURE^ FPSection(VAR pars : Id.ParSeq; thisP, defScp : Sy.Scope);
199 PROCEDURE^ type(defScp : Sy.Scope; vMod : INTEGER) : Sy.Type;
200 PROCEDURE^ identDef(inhScp : Sy.Scope; tag : INTEGER) : Sy.Idnt;
201 PROCEDURE^ constExpression(defScp : Sy.Scope) : Xp.LeafX;
202 PROCEDURE^ expression(scope : Sy.Scope) : Sy.Expr;
203 PROCEDURE^ designator(inhScp : Sy.Scope) : Sy.Expr;
204 PROCEDURE^ OptExprList(VAR xList : Sy.ExprSeq; inhScp : Sy.Scope);
205 PROCEDURE^ ExprList(VAR xList : Sy.ExprSeq; inhScp : Sy.Scope);
206 PROCEDURE^ statementSequence(inhLp : Sy.Stmt; inhSc : Sy.Scope) : Sy.Stmt;
207 PROCEDURE^ ProcedureStuff(scope : Sy.Scope);
208 PROCEDURE^ CheckVisibility(seq : Sy.IdSeq; in : INTEGER; OUT out : INTEGER);
209 PROCEDURE^ FormalParameters(thsP : Ty.Procedure;
210 proc : Id.Procs;
211 scpe : Sy.Scope);
212
213 (* ==================================================================== *)
214
215 PROCEDURE CPmodule();
216 VAR name : LitValue.CharOpen;
217 BEGIN
218 Expect(T.MODULESym);
219 Expect(T.identSym);
220 Cs.thisMod.hash := NameHash.enterSubStr(token.pos, token.len);
221 Cs.thisMod.token := token;
222 Sy.getName.Of(Cs.thisMod, Cs.modNam);
223 (* Manual addition 15-June-2000. *)
224 IF nextT.sym = T.lbrackSym THEN
225 Get;
226 IF Cs.strict THEN SemError(221); END;
227 Expect(T.stringSym);
228 name := LitValue.subStrToCharOpen(token.pos+1, token.len-2);
229 Cs.thisMod.scopeNm := name;
230 Expect(T.rbrackSym);
231 IF Cs.verbose THEN Cs.Message('external modName "' + name^ + '"') END;
232 END;
233 (* End addition 15-June-2000 kjg *)
234 Expect(T.semicolonSym);
235 IF (nextT.sym = T.IMPORTSym) THEN
236 ImportList(Cs.thisMod);
237 ELSE
238 Sy.ResetScpSeq(Cs.impSeq);
239 END;
240 DeclarationSequence(Cs.thisMod);
241 IF (nextT.sym = T.BEGINSym) THEN
242 Cs.thisMod.begTok := nextT;
243 Get;
244 (*
245 * "BEGIN" [ '[' "UNCHECKED_ARITHMETIC" ']' ] ...
246 *)
247 IF nextT.sym = T.lbrackSym THEN
248 Get;
249 IF Cs.strict THEN SemError(221); END;
250 Expect(T.identSym);
251 IF NameHash.enterSubStr(token.pos, token.len) = Bi.noChkB THEN
252 Cs.thisMod.ovfChk := FALSE;
253 ELSE
254 SemError(194);
255 END;
256 Expect(T.rbrackSym);
257 END;
258 Cs.thisMod.modBody := statementSequence(NIL, Cs.thisMod);
259 IF (nextT.sym = T.CLOSESym) THEN
260 Get;
261 Cs.thisMod.modClose := statementSequence(NIL, Cs.thisMod);
262 END;
263 END;
264 END CPmodule;
265
266 (* ==================================================================== *)
267
268 PROCEDURE ForeignMod();
269 VAR name : LitValue.CharOpen;
270 BEGIN
271 Expect(T.MODULESym);
272 Expect(T.identSym);
273 Cs.thisMod.hash := NameHash.enterSubStr(token.pos, token.len);
274 Cs.thisMod.token := token;
275 Sy.getName.Of(Cs.thisMod, Cs.modNam);
276 IF nextT.sym = T.lbrackSym THEN
277 Get;
278 Expect(T.stringSym);
279 name := LitValue.subStrToCharOpen(token.pos+1, token.len-2);
280 Cs.thisMod.scopeNm := name;
281 Expect(T.rbrackSym);
282 IF Cs.verbose THEN Cs.Message('external modName "' + name^ + '"') END;
283 END;
284 Expect(T.semicolonSym);
285 IF (nextT.sym = T.IMPORTSym) THEN
286 ImportList(Cs.thisMod);
287 ELSE
288 Sy.ResetScpSeq(Cs.impSeq);
289 END;
290 DeclarationSequence(Cs.thisMod);
291 END ForeignMod;
292
293 (* ==================================================================== *)
294
295 PROCEDURE Import (modScope : Id.BlkId; VAR impSeq : Sy.ScpSeq);
296 VAR ident : Id.BlkId; (* The imported module name descriptor *)
297 alias : Id.BlkId; (* The declared alias name (optional) *)
298 clash : Sy.Idnt;
299 dummy : BOOLEAN;
300 idHsh : INTEGER;
301 strng : LitValue.CharOpen;
302 impNm : LitValue.CharOpen;
303 BEGIN
304 alias := NIL;
305 ident := Id.newImpId();
306 Expect(T.identSym);
307 IF (nextT.sym = T.colonequalSym) THEN
308 alias := Id.newAlias();
309 alias.hash := NameHash.enterSubStr(token.pos, token.len);
310 IF Sy.refused(alias, modScope) THEN SemError(4) END;
311 Get; (* Read past colonequals symbol *)
312 (*
313 * the place to put
314 * Here is ^ the experimental processing for the option
315 * of using a literal string at this position. If there
316 * is a literal string, it should be mapped to the default
317 * name here.
318 *)
319 IF nextT.sym = T.stringSym THEN
320 Get;
321 strng := LitValue.subStrToCharOpen(token.pos+1, token.len-2);
322 ForeignName.ParseModuleString(strng, impNm);
323 alias.token := token; (* fake the name for err-msg use *)
324 idHsh := NameHash.enterStr(impNm);
325 IF Cs.strict THEN Error(221) END;
326 ELSE
327 Expect(T.identSym);
328 alias.token := token; (* fake the name for err-msg use *)
329 ident.aliasMod := alias;
330 IF Cs.verbose THEN alias.SetNameFromHash(alias.hash) END;
331 idHsh := NameHash.enterSubStr(token.pos, token.len);
332 END;
333 ELSE
334 idHsh := NameHash.enterSubStr(token.pos, token.len);
335 END;
336 ident.token := token;
337 ident.dfScp := ident;
338 ident.hash := idHsh;
339
340 IF Cs.verbose THEN ident.SetNameFromHash(idHsh) END;
341
342 IF ident.hash = Bi.sysBkt THEN
343 dummy := Cs.thisMod.symTb.enter(Bi.sysBkt, Cs.sysMod);
344 IF Cs.verbose THEN Cs.Message("imports unsafe SYSTEM module") END;
345 IF ~Cs.unsafe THEN SemError(227);
346 ELSIF ~Cs.targetIsNET() THEN SemError(228);
347 END;
348 ELSE
349 INCL(ident.xAttr, Sy.weak);
350 END;
351
352 clash := Sy.bind(ident.hash, modScope);
353 IF clash = NIL THEN
354 dummy := Sy.refused(ident, modScope);
355 ELSIF clash.kind = Id.impId THEN
356 (*
357 * This import might already be known as a result of an
358 * indirect import. If that is the case, then we must
359 * substitute the old descriptor for "ident" in case there
360 * there are already references to it in the structure.
361 *)
362 clash.token := ident.token; (* to help error reports *)
363 IF Cs.verbose THEN clash.SetNameFromHash(clash.hash) END;
364 ident := clash(Id.BlkId);
365 (*
366 * If this is the explicit import of a module that
367 * has an alias, then all is ok, make import usable.
368 *)
369 IF ident.aliasMod # NIL THEN
370 EXCL(ident.xAttr, Sy.anon);
371 IF alias # NIL THEN (* multiple aliases for same module *)
372 SemErrorS1(240, Sy.getName.ChPtr(ident.aliasMod));
373 END;
374 (*
375 * If ident is the target of an alias then the
376 * target is also made visible in the module.
377 *)
378 ELSIF alias # NIL THEN
379 ident.aliasMod := alias;
380 (*
381 * Else this really is an error.
382 *)
383 ELSIF ~ident.isWeak() &
384 (ident.hash # Bi.sysBkt) THEN SemError(170); (* imported twice *)
385 END;
386 ELSE
387 SemError(4);
388 END;
389
390 IF ident.hash = NameHash.mainBkt THEN
391 modScope.main := TRUE; (* the import is "CPmain" *)
392 IF Cs.verbose THEN Cs.Message("contains CPmain entry point") END;
393 INCL(modScope.xAttr, Sy.cMain); (* Console Main *)
394 ELSIF ident.hash = NameHash.winMain THEN
395 modScope.main := TRUE; (* the import is "WinMain" *)
396 INCL(modScope.xAttr, Sy.wMain); (* Windows Main *)
397 IF Cs.verbose THEN Cs.Message("contains WinMain entry point") END;
398 ELSIF ident.hash = NameHash.staBkt THEN
399 INCL(modScope.xAttr, Sy.sta);
400 IF Cs.verbose THEN Cs.Message("sets Single Thread Apartment") END;
401 END;
402
403 IF Sy.weak IN ident.xAttr THEN
404 (*
405 * Module ident is a newly declared import.
406 * List the file, for importation later ...
407 *)
408 Sy.AppendScope(impSeq, ident);
409 IF alias # NIL THEN INCL(ident.xAttr, Sy.anon) END;
410 EXCL(ident.xAttr, Sy.weak); (* ==> directly imported *)
411 INCL(ident.xAttr, Sy.need); (* ==> needed in symfile *)
412 END;
413 (*
414 * Alias (if any) must appear after ImpId
415 *)
416 IF alias # NIL THEN
417 alias.dfScp := ident;
418 Sy.AppendScope(impSeq, alias);
419 END;
420 END Import;
421
422 PROCEDURE ImportThreading(modScope : Id.BlkId; VAR impSeq : Sy.ScpSeq);
423 VAR hash : INTEGER;
424 idnt : Id.BlkId;
425 BEGIN
426 hash := NameHash.enterStr("mscorlib_System_Threading");
427 idnt := Id.newImpId();
428 idnt.dfScp := idnt;
429 idnt.hash := hash;
430 IF ~Sy.refused(idnt, modScope) THEN
431 EXCL(idnt.xAttr, Sy.weak);
432 INCL(idnt.xAttr, Sy.need);
433 Sy.AppendScope(impSeq, idnt);
434 END;
435 END ImportThreading;
436
437 (* ==================================================================== *)
438
439 PROCEDURE ImportList (modScope : Id.BlkId);
440 VAR index : INTEGER;
441 BEGIN
442 Get;
443 Sy.ResetScpSeq(Cs.impSeq);
444 Import(modScope, Cs.impSeq);
445 WHILE (nextT.sym = T.commaSym) DO
446 Get;
447 Import(modScope, Cs.impSeq);
448 END;
449 Expect(T.semicolonSym);
450 (*
451 * Now some STA-specific tests.
452 *)
453 IF Sy.sta IN modScope.xAttr THEN
454 IF Sy.trgtNET THEN
455 ImportThreading(modScope, Cs.impSeq);
456 ELSE
457 SemError(238);
458 END;
459 IF ~modScope.main THEN
460 SemError(319);
461 EXCL(modScope.xAttr, Sy.sta);
462 END;
463 END;
464
465 Cs.import1 := RTS.GetMillis();
466 IF Cs.legacy THEN
467 OldSymFileRW.WalkImports(Cs.impSeq, modScope);
468 ELSE
469 NewSymFileRW.WalkImports(Cs.impSeq, modScope);
470 END;
471 Cs.import2 := RTS.GetMillis();
472 END ImportList;
473
474 (* ==================================================================== *)
475
476 PROCEDURE FPSection(VAR pars : Id.ParSeq; thisP, defScp : Sy.Scope);
477 (* sequence is passed in from the caller *)
478 VAR mode : INTEGER;
479 indx : INTEGER;
480 parD : Id.ParId;
481 tpDx : Sy.Type;
482 tokn : S.Token;
483 pTst : BOOLEAN; (* test if formal type is private *)
484 (* --------------------------- *)
485 PROCEDURE isPrivate(t : Sy.Type) : BOOLEAN;
486 BEGIN
487 RETURN ~(t IS Ty.Base) & (t.idnt.vMod = Sy.prvMode);
488 END isPrivate;
489 (* --------------------------- *)
490 PROCEDURE CheckFormalType(tst : BOOLEAN; tok : S.Token; typ : Sy.Type);
491 BEGIN (*
492 * There are two separate kinds of tests here:
493 * * formals must not be less visible than the procedure
494 * * anonymous formals are only useful in two cases:
495 * - open arrays, provided the element type is visible enough;
496 * - pointer types, provided the bound type is visible enough.
497 *)
498 IF typ = NIL THEN RETURN;
499 ELSIF typ.idnt # NIL THEN
500 IF tst & isPrivate(typ) THEN SemErrorT(150, tok) END;
501 ELSE
502 WITH typ : Ty.Record DO
503 SemErrorT(314, tok);
504 | typ : Ty.Pointer DO
505 CheckFormalType(tst, tok, typ.boundTp);
506 | typ : Ty.Array DO
507 CheckFormalType(tst, tok, typ.elemTp);
508 (* Open arrays and vectors have length = 0 *)
509 IF typ.length # 0 THEN SemErrorT(315, tok) END;
510 ELSE (* skip procs? *)
511 END;
512 END;
513 END CheckFormalType;
514 (* --------------------------- *)
515 BEGIN
516 Id.ResetParSeq(pars); (* make sequence empty *)
517 IF nextT.sym = T.INSym THEN
518 Get;
519 mode := Sy.in;
520 ELSIF nextT.sym = T.OUTSym THEN
521 Get;
522 mode := Sy.out;
523 ELSIF nextT.sym = T.VARSym THEN
524 Get;
525 mode := Sy.var;
526 ELSE
527 mode := Sy.val;
528 END;
529 parD := identDef(defScp, Id.parId)(Id.ParId);
530 Id.AppendParam(pars, parD);
531 WHILE weakSeparator(12, 1, 2) DO
532 parD := identDef(defScp, Id.parId)(Id.ParId);
533 Id.AppendParam(pars, parD);
534 END;
535 Expect(T.colonSym);
536 tokn := nextT;
537 tpDx := type(defScp, Sy.prvMode);
538 IF tpDx # NIL THEN
539 pTst := ~Cs.special & (thisP # NIL) & (thisP.vMod = Sy.pubMode);
540
541 CheckFormalType(pTst, tokn, tpDx);
542
543 FOR indx := 0 TO pars.tide-1 DO
544 pars.a[indx].parMod := mode;
545 pars.a[indx].type := tpDx;
546 END;
547 END;
548 END FPSection;
549
550 (* ==================================================================== *)
551
552 PROCEDURE DeclarationSequence (defScp : Sy.Scope);
553 BEGIN
554 WHILE (nextT.sym = T.CONSTSym) OR
555 (nextT.sym = T.TYPESym) OR
556 (nextT.sym = T.VARSym) DO
557 IF (nextT.sym = T.CONSTSym) THEN
558 Get;
559 WHILE (nextT.sym = T.identSym) DO
560 ConstantDeclaration(defScp);
561 Expect(T.semicolonSym);
562 END;
563 ELSIF (nextT.sym = T.TYPESym) THEN
564 Get;
565 WHILE (nextT.sym = T.identSym) DO
566 TypeDeclaration(defScp);
567 Expect(T.semicolonSym);
568 END;
569 ELSE
570 Get;
571 WHILE (nextT.sym = T.identSym) DO
572 VariableDeclaration(defScp);
573 Expect(T.semicolonSym);
574 END;
575 END;
576 END;
577 (* Last chance to resolve forward types in this block *)
578 defScp.endDecl := TRUE;
579 TypeResolve(defScp);
580 (* Now the local procedures *)
581 WHILE (nextT.sym = T.PROCEDURESym) DO
582 ProcedureStuff(defScp);
583 Expect(T.semicolonSym);
584 END;
585 END DeclarationSequence;
586
587 (* ==================================================================== *)
588
589 PROCEDURE otherAtts(in : SET) : SET;
590 BEGIN
591 IF nextT.sym = T.ABSTRACTSym THEN
592 Get;
593 RETURN in + Id.isAbs;
594 ELSIF nextT.sym = T.EMPTYSym THEN
595 Get;
596 RETURN in + Id.empty;
597 ELSIF nextT.sym = T.EXTENSIBLESym THEN
598 Get;
599 RETURN in + Id.extns;
600 ELSE
601 Error(77);
602 RETURN in;
603 END;
604 END otherAtts;
605
606 (* ==================================================================== *)
607
608 PROCEDURE^ MethAttributes(pDesc : Id.Procs);
609
610 (* ==================================================================== *)
611
612 PROCEDURE receiver(scope : Sy.Scope) : Id.ParId;
613 VAR mode : INTEGER;
614 parD : Id.ParId;
615 rcvD : Sy.Idnt;
616 BEGIN
617 Get; (* read past lparenSym *)
618 IF nextT.sym = T.INSym THEN
619 Get;
620 mode := Sy.in;
621 ELSIF nextT.sym = T.VARSym THEN
622 Get;
623 mode := Sy.var;
624 ELSE
625 mode := Sy.val;
626 END;
627 parD := identDef(scope, Id.parId)(Id.ParId);
628 parD.isRcv := TRUE;
629 parD.parMod := mode;
630 Expect(T.colonSym);
631 Expect(T.identSym);
632 rcvD := bindToken(scope);
633 IF rcvD = NIL THEN
634 SemError(2);
635 ELSIF ~(rcvD IS Id.TypId) THEN
636 SemError(5);
637 ELSE
638 parD.type := rcvD.type;
639 END;
640 Expect(T.rparenSym);
641 RETURN parD;
642 END receiver;
643
644 (* ==================================================================== *)
645
646 PROCEDURE ExceptBody(pInhr : Id.Procs);
647 VAR excp : Id.LocId;
648 BEGIN
649 (*
650 * This procedure has an exception handler. We must...
651 * (i) define a local to hold the exception value
652 * (ii) parse the rescue statement sequence
653 *)
654 Expect(T.lparenSym);
655 excp := identDef(pInhr, Id.varId)(Id.LocId);
656 excp.SetKind(Id.conId); (* mark immutable *)
657 excp.type := Cs.ntvExc;
658 excp.varOrd := pInhr.locals.tide;
659 IF Sy.refused(excp, pInhr) THEN
660 excp.IdError(4);
661 ELSE
662 Sy.AppendIdnt(pInhr.locals, excp);
663 pInhr.except := excp;
664 END;
665 Expect(T.rparenSym);
666 pInhr.rescue := statementSequence(NIL, pInhr); (* inhLp is NIL *)
667 END ExceptBody;
668
669 (* ==================================================================== *)
670
671 PROCEDURE ProcedureBody(pInhr : Id.Procs);(* Inherited descriptor *)
672 BEGIN
673 DeclarationSequence(pInhr);
674 IF nextT.sym = T.BEGINSym THEN
675 Get;
676 (*
677 * "BEGIN" [ '[' "UNCHECKED_ARITHMETIC" ']' ] ...
678 *)
679 IF nextT.sym = T.lbrackSym THEN
680 Get;
681 Expect(T.identSym);
682 IF NameHash.enterSubStr(token.pos, token.len) = Bi.noChkB THEN
683 pInhr.ovfChk := FALSE;
684 ELSE
685 SemError(194);
686 END;
687 Expect(T.rbrackSym);
688 END;
689 pInhr.body := statementSequence(NIL, pInhr); (* inhLp is NIL *)
690 END;
691 IF nextT.sym = T.RESCUESym THEN
692 Get;
693 IF Cs.strict THEN SemError(221); END;
694 ExceptBody(pInhr);
695 END;
696 Expect(T.ENDSym);
697 END ProcedureBody;
698
699 (* ==================================================================== *)
700
701 PROCEDURE procedureHeading(scope : Sy.Scope) : Id.Procs;
702 VAR rcvD : Id.ParId;
703 prcD : Id.Procs;
704 mthD : Id.MthId;
705 prcT : Ty.Procedure;
706 name : LitValue.CharOpen;
707 BEGIN
708 IF nextT.sym # T.lparenSym THEN
709 rcvD := NIL;
710 prcD := identDef(scope, Id.conPrc)(Id.Procs);
711 prcD.SetKind(Id.conPrc);
712 ELSE
713 rcvD := receiver(scope);
714 mthD := identDef(scope, Id.conMth)(Id.MthId);
715 mthD.SetKind(Id.conMth);
716 IF (rcvD.type # NIL) &
717 (rcvD.type.idnt # NIL) THEN
718 IF rcvD.type.isInterfaceType() &
719 (mthD.vMod = Sy.prvMode) THEN SemError(216);
720 END;
721 END;
722 prcD := mthD;
723 mthD.rcvFrm := rcvD;
724 IF Sy.refused(rcvD, mthD) THEN (* insert receiver in scope *)
725 rcvD.IdError(4); (* refusal impossible maybe? *)
726 ELSE
727 rcvD.dfScp := mthD; (* Correct the defScp *)
728 rcvD.varOrd := mthD.locals.tide;
729 Sy.AppendIdnt(mthD.locals, rcvD);
730 END;
731 END;
732 IF nextT.sym = T.lbrackSym THEN
733 IF ~Cs.special THEN SemError(144) END;
734 Get;
735 Expect(T.stringSym);
736 name := LitValue.subStrToCharOpen(token.pos+1, token.len-2);
737 prcD.prcNm := name;
738 Expect(T.rbrackSym);
739 IF Cs.verbose THEN Cs.Message('external procName "' + name^ + '"') END;
740 END;
741 prcT := Ty.newPrcTp();
742 prcT.idnt := prcD;
743 prcD.type := prcT;
744 IF prcD.vMod # Sy.prvMode THEN INCL(prcD.pAttr, Id.public) END;
745 IF nextT.sym = T.lparenSym THEN
746 FormalParameters(prcT, prcD, scope);
747 END;
748 IF nextT.sym = T.commaSym THEN
749 Get;
750 MethAttributes(prcD);
751 END;
752 IF rcvD # NIL THEN prcT.receiver := rcvD.type END;
753 prcD.EnterProc(rcvD, scope);
754 RETURN prcD;
755 END procedureHeading;
756
757 (* ==================================================================== *)
758
759 PROCEDURE ProcDeclStuff(scope : Sy.Scope);
760 VAR desc : Id.Procs;
761 name : FileNames.NameString;
762 pNam : FileNames.NameString;
763 errN : INTEGER;
764 BEGIN
765 desc := procedureHeading(scope);
766 WITH scope : Id.Procs DO (* a nested proc *)
767 Id.AppendProc(scope.nestPs, desc);
768 desc.lxDepth := scope.lxDepth + 1;
769 ELSE
770 desc.lxDepth := 0;
771 END;
772 Id.AppendProc(Cs.thisMod.procs, desc);
773 IF ~desc.isEmpty() & ~Cs.isForeign() THEN
774 Expect(T.semicolonSym);
775 ProcedureBody(desc);
776 desc.endSpan := S.mkSpanTT(token, nextT);
777 Expect(T.identSym);
778 (* check closing name *)
779 S.GetString(token.pos, token.len, name);
780 Sy.getName.Of(desc, pNam);
781 IF name # pNam THEN
782 IF token.sym = T.identSym THEN errN := 1 ELSE errN := 0 END;
783 SemErrorS1(errN, pNam$);
784 END;
785 END;
786 END ProcDeclStuff;
787
788 (* ==================================================================== *)
789
790 PROCEDURE ForwardStuff(scope : Sy.Scope);
791 VAR desc : Id.Procs;
792 BEGIN
793 Get; (* read past uparrowSym *)
794 desc := procedureHeading(scope);
795 (* Set lexical depth for forward procs as well. kjg Sep-2001 *)
796 WITH scope : Id.Procs DO (* a nested proc *)
797 desc.lxDepth := scope.lxDepth + 1;
798 ELSE
799 desc.lxDepth := 0;
800 END;
801 IF desc.kind = Id.conMth THEN
802 desc.setPrcKind(Id.fwdMth);
803 ELSIF desc.kind = Id.conPrc THEN
804 desc.setPrcKind(Id.fwdPrc);
805 END;
806 Id.AppendProc(Cs.thisMod.procs, desc);
807 END ForwardStuff;
808
809 (* ==================================================================== *)
810
811 PROCEDURE ProcedureStuff(scope : Sy.Scope);
812 (* parse procedure and add to list in scope *)
813 BEGIN
814 Get; (* read past PROCEDURESym *)
815 IF nextT.sym = T.uparrowSym THEN
816 ForwardStuff(scope);
817 ELSIF (nextT.sym = T.identSym) OR
818 (nextT.sym = T.lparenSym) THEN
819 ProcDeclStuff(scope);
820 ELSE Error(79);
821 END;
822 END ProcedureStuff;
823
824 (* ==================================================================== *)
825
826 PROCEDURE guard(scope : Sy.Scope) : Sy.Expr;
827 VAR expr : Xp.BinaryX;
828 qual : Sy.Expr;
829 dstX : Sy.Expr; (* should be typeQualid *)
830 BEGIN
831 qual := Xp.mkIdLeaf(qualident(scope));
832 Expect(T.colonSym);
833 expr := Xp.newBinaryX(Xp.isOp, qual, NIL);
834 dstX := Xp.mkIdLeaf(typeQualid(scope));
835 (* Check #1 : that the expression has a type that is dynamic *)
836 IF ~qual.hasDynamicType() THEN qual.ExprError(17) END;
837 (* Check #2 : that manifest type is a base of the asserted type *)
838 IF (qual.type # NIL) &
839 ~qual.type.isBaseOf(dstX.type) &
840 ~qual.type.isInterfaceType() &
841 ~dstX.type.isInterfaceType() THEN SemError(15) END;
842 expr.rKid := dstX;
843 RETURN expr;
844 END guard;
845
846 (* ==================================================================== *)
847
848 PROCEDURE caseLabel(chTp : BOOLEAN;
849 tide : INTEGER;
850 scope : Sy.Scope) : StatDesc.Triple;
851 VAR lExp, rExp : Sy.Expr;
852 xpOk : BOOLEAN;
853 lo, hi : INTEGER;
854 BEGIN
855 lo := 0; hi := 0;
856 xpOk := TRUE;
857 lExp := constExpression(scope);
858 IF lExp # NIL THEN
859 IF chTp THEN
860 IF lExp.isCharLit() THEN
861 lo := ORD(lExp(Xp.LeafX).charValue());
862 ELSE
863 lExp.ExprError(43); xpOk := FALSE;
864 END;
865 ELSE
866 IF lExp.isNumLit() THEN
867 lo := lExp(Xp.LeafX).value.int();
868 ELSE
869 lExp.ExprError(37); xpOk := FALSE;
870 END;
871 END;
872 ELSE xpOk := FALSE;
873 END;
874 IF nextT.sym = T.pointpointSym THEN
875 Get;
876 rExp := constExpression(scope);
877 IF rExp # NIL THEN
878 IF chTp THEN
879 IF rExp.isCharLit() THEN
880 hi := ORD(rExp(Xp.LeafX).charValue());
881 ELSE
882 rExp.ExprError(43); xpOk := FALSE;
883 END;
884 ELSE
885 IF rExp.isNumLit() THEN
886 hi := rExp(Xp.LeafX).value.int();
887 ELSE
888 rExp.ExprError(37); xpOk := FALSE;
889 END;
890 END;
891 ELSE xpOk := FALSE;
892 END;
893 IF xpOk & (lo > hi) THEN lExp.ExprError(30) END;
894 ELSE
895 hi := lo;
896 END;
897 RETURN StatDesc.newTriple(lo, hi, tide);
898 END caseLabel;
899
900 (* ==================================================================== *)
901
902 PROCEDURE CaseLabelList(VAR labels : StatDesc.TripleSeq;
903 isChar : BOOLEAN;
904 stTide : INTEGER;
905 scope : Sy.Scope);
906 VAR next : StatDesc.Triple;
907 BEGIN
908 next := caseLabel(isChar, stTide, scope);
909 StatDesc.AppendTriple(labels, next);
910 WHILE nextT.sym = T.commaSym DO
911 Get;
912 next := caseLabel(isChar, stTide, scope);
913 StatDesc.AppendTriple(labels, next);
914 END;
915 END CaseLabelList;
916
917 (* ==================================================================== *)
918
919 PROCEDURE Case(desc : StatDesc.CaseSt; inhLp : Sy.Stmt; scope : Sy.Scope);
920 BEGIN
921 IF in(symSet[3], nextT.sym) THEN
922 CaseLabelList(desc.labels, desc.chrSel, desc.blocks.tide, scope);
923 Expect(T.colonSym);
924 Sy.AppendStmt(desc.blocks, statementSequence(inhLp, scope));
925 END;
926 END Case;
927
928 (* ==================================================================== *)
929
930 PROCEDURE ActualParameters(VAR rslt : Sy.ExprSeq; inhScp : Sy.Scope);
931 BEGIN
932 Expect(T.lparenSym);
933 OptExprList(rslt, inhScp);
934 Expect(T.rparenSym);
935 END ActualParameters;
936
937 (* ==================================================================== *)
938
939 PROCEDURE withStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
940 VAR synthS : StatDesc.Choice;
941 predXp : Sy.Expr;
942 block : Sy.Stmt;
943 savedI : Sy.Idnt;
944 tmpId : Id.LocId;
945 BEGIN
946 Get;
947 synthS := StatDesc.newWithS();
948 IF nextT.sym = T.ENDSym THEN
949 Get;
950 SemError(318);
951 RETURN synthS;
952 ELSIF nextT.sym = T.barSym THEN
953 Get;
954 IF Cs.strict THEN SemError(221); END;
955 END;
956 IF nextT.sym # T.ELSESym THEN
957 predXp := guard(scope);
958 Expect(T.DOSym);
959
960 tmpId := Id.newLocId();
961 tmpId.dfScp := scope;
962
963 savedI := predXp.enterGuard(tmpId);
964 block := statementSequence(inhLp, scope);
965 predXp.ExitGuard(savedI, tmpId);
966 Sy.AppendIdnt(synthS.temps, tmpId);
967 Sy.AppendExpr(synthS.preds, predXp);
968 Sy.AppendStmt(synthS.blocks, block);
969 WHILE nextT.sym = T.barSym DO
970 Get;
971 predXp := guard(scope);
972 Expect(T.DOSym);
973
974 tmpId := Id.newLocId();
975 tmpId.dfScp := scope;
976
977 savedI := predXp.enterGuard(tmpId);
978 block := statementSequence(inhLp, scope);
979 predXp.ExitGuard(savedI, tmpId);
980 Sy.AppendIdnt(synthS.temps, tmpId);
981 Sy.AppendExpr(synthS.preds, predXp);
982 Sy.AppendStmt(synthS.blocks, block);
983 END;
984 END;
985 IF nextT.sym = T.ELSESym THEN
986 Get;
987 block := statementSequence(inhLp, scope);
988 Sy.AppendIdnt(synthS.temps, NIL);
989 Sy.AppendExpr(synthS.preds, NIL);
990 Sy.AppendStmt(synthS.blocks, block);
991 END;
992 Expect(T.ENDSym);
993 RETURN synthS;
994 END withStatement;
995
996 (* ==================================================================== *)
997
998 PROCEDURE loopStatement(scope : Sy.Scope) : Sy.Stmt;
999 (* This procedure ignores the inherited attribute which for *
1000 * other cases designates the enclosing loop. This becomes *
1001 * the source of the enclosing loop for all nested statements *)
1002 VAR newLoop : StatDesc.TestLoop;
1003 BEGIN
1004 Get;
1005 newLoop := StatDesc.newLoopS();
1006 newLoop.body := statementSequence(newLoop, scope);
1007 Expect(T.ENDSym);
1008 RETURN newLoop;
1009 END loopStatement;
1010
1011 (* ==================================================================== *)
1012
1013 PROCEDURE forStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1014 VAR rslt : StatDesc.ForLoop;
1015 cIdn : Sy.Idnt;
1016
1017 (* ------------------------- *)
1018 PROCEDURE Check(id : Sy.Idnt);
1019 BEGIN
1020 IF id = NIL THEN SemError(2);
1021 ELSIF ~(id IS Id.AbVar) THEN SemError(85);
1022 ELSIF ~id.mutable() THEN SemError(103);
1023 ELSIF (id.type # NIL) & ~id.type.isIntType() THEN SemError(84);
1024 END;
1025 END Check;
1026 (* ------------------------- *)
1027
1028 BEGIN
1029 Get;
1030 rslt := StatDesc.newForStat();
1031 Expect(T.identSym);
1032 cIdn := bindToken(scope);
1033 Check(cIdn);
1034 Expect(T.colonequalSym);
1035 rslt.cVar := cIdn;
1036 rslt.loXp := expression(scope);
1037 Expect(T.TOSym);
1038 rslt.hiXp := expression(scope);
1039 IF (nextT.sym = T.BYSym) THEN
1040 Get;
1041 rslt.byXp := constExpression(scope);
1042 IF rslt.byXp # NIL THEN
1043 IF rslt.byXp.kind # Xp.numLt THEN
1044 rslt.byXp.ExprError(59);
1045 ELSIF rslt.byXp(Xp.LeafX).value.long() = 0 THEN
1046 rslt.byXp.ExprError(81);
1047 END;
1048 END;
1049 ELSE
1050 rslt.byXp := Xp.mkNumLt(1);
1051 END;
1052 Expect(T.DOSym);
1053 rslt.body := statementSequence(inhLp, scope);
1054 Expect(T.ENDSym);
1055 RETURN rslt;
1056 END forStatement;
1057
1058 (* ==================================================================== *)
1059
1060 PROCEDURE repeatStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1061 VAR rslt : StatDesc.TestLoop;
1062 BEGIN
1063 Get;
1064 rslt := StatDesc.newRepeatS();
1065 rslt.body := statementSequence(inhLp, scope);
1066 Expect(T.UNTILSym);
1067 rslt.test := expression(scope);
1068 RETURN rslt;
1069 END repeatStatement;
1070
1071 (* ==================================================================== *)
1072
1073 PROCEDURE whileStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1074 VAR rslt : StatDesc.TestLoop;
1075 BEGIN
1076 Get;
1077 rslt := StatDesc.newWhileS();
1078 rslt.test := expression(scope);
1079 Expect(T.DOSym);
1080 rslt.body := statementSequence(inhLp, scope);
1081 Expect(T.ENDSym);
1082 RETURN rslt;
1083 END whileStatement;
1084
1085 (* ==================================================================== *)
1086
1087 PROCEDURE caseStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1088 VAR rslt : StatDesc.CaseSt;
1089 slct : Sy.Expr;
1090 isCh : BOOLEAN;
1091 BEGIN
1092 Get;
1093 rslt := StatDesc.newCaseS();
1094 slct := expression(scope);
1095 Expect(T.OFSym);
1096 IF slct # NIL THEN slct := slct.exprAttr() END;
1097 IF (slct # NIL) & (slct.type # NIL) THEN
1098 rslt.chrSel := FALSE;
1099 rslt.select := slct;
1100 IF slct.isCharExpr() THEN
1101 rslt.chrSel := TRUE;
1102 ELSIF slct.isIntExpr() THEN
1103 IF slct.type.isLongType() THEN slct.ExprError(141) END;
1104 ELSE
1105 slct.ExprError(88);
1106 END;
1107 END;
1108 IF nextT.sym = T.ENDSym THEN
1109 SemError(317);
1110 ELSE
1111 Case(rslt, inhLp, scope);
1112 WHILE nextT.sym = T.barSym DO
1113 Get;
1114 Case(rslt, inhLp, scope);
1115 END;
1116 IF nextT.sym = T.ELSESym THEN
1117 Get;
1118 rslt.elsBlk := statementSequence(inhLp, scope);
1119 END;
1120 END;
1121 Expect(T.ENDSym);
1122 RETURN rslt;
1123 END caseStatement;
1124
1125 (* ==================================================================== *)
1126
1127 PROCEDURE ifStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1128 VAR synthStat : StatDesc.Choice;
1129 BEGIN
1130 Get;
1131 synthStat := StatDesc.newIfStat();
1132 Sy.AppendExpr(synthStat.preds, expression(scope));
1133 Expect(T.THENSym);
1134 Sy.AppendStmt(synthStat.blocks, statementSequence(inhLp, scope));
1135 WHILE nextT.sym = T.ELSIFSym DO
1136 Get;
1137 Sy.AppendExpr(synthStat.preds, expression(scope));
1138 Expect(T.THENSym);
1139 Sy.AppendStmt(synthStat.blocks, statementSequence(inhLp, scope));
1140 END;
1141 IF (nextT.sym = T.ELSESym) THEN
1142 Get;
1143 Sy.AppendExpr(synthStat.preds, NIL);
1144 Sy.AppendStmt(synthStat.blocks, statementSequence(inhLp, scope));
1145 END;
1146 Expect(T.ENDSym);
1147 RETURN synthStat;
1148 END ifStatement;
1149
1150 (* ==================================================================== *)
1151
1152 PROCEDURE^ ConvertOverloaded(VAR e : Sy.Expr);
1153
1154 PROCEDURE^ makeCall(xCr : Sy.Expr; IN actuals : Sy.ExprSeq;
1155 inhScp : Sy.Scope) : Sy.Expr;
1156
1157 (* ==================================================================== *)
1158
1159 PROCEDURE identStatement(inhLp : Sy.Stmt; scope : Sy.Scope) : Sy.Stmt;
1160 VAR assign : StatDesc.Assign;
1161 prCall : StatDesc.ProcCall;
1162 argLst : Sy.ExprSeq;
1163 desig : Sy.Expr;
1164 value : Sy.Expr;
1165 saveT : S.Token;
1166 BEGIN
1167 saveT := nextT;
1168 desig := designator(scope);
1169 IF nextT.sym = T.colonequalSym THEN
1170 ConvertOverloaded(desig);
1171 IF desig # NIL THEN desig.tSpan := S.mkSpanTT(saveT, S.prevTok) END;
1172 Get;
1173 assign := StatDesc.newAssignS();
1174 value := expression(scope);
1175 assign.lhsX := desig;
1176 assign.rhsX := value;
1177 Xp.CheckIsVariable(desig);
1178 RETURN assign;
1179 ELSIF in(symSet[8], nextT.sym) THEN
1180 IF (desig # NIL) & ~(desig IS Xp.CallX) THEN
1181 desig := makeCall(desig,argLst,scope);
1182 END;
1183 prCall := StatDesc.newProcCall();
1184 prCall.expr := desig;
1185 IF desig # NIL THEN desig.tSpan := S.mkSpanTT(saveT, S.prevTok) END;
1186 IF (desig # NIL) &
1187 (desig.type # NIL) & ~desig.type.isProperProcType() THEN
1188 desig.ExprError(182);
1189 END;
1190 RETURN prCall;
1191 ELSE Error(82); RETURN StatDesc.newEmptyS();
1192 END;
1193 END identStatement;
1194
1195 (* ==================================================================== *)
1196
1197 PROCEDURE statement(inhLp : Sy.Stmt; inhSc : Sy.Scope) : Sy.Stmt;
1198 VAR synthStat : Sy.Stmt;
1199 synthExpr : Sy.Expr;
1200 keywordTk : S.Token;
1201
1202 (* ------------------------- *)
1203
1204 PROCEDURE newStatement(inhSc : Sy.Scope) : Sy.Stmt;
1205 (* This case is pulled out of line, so that the cost of *
1206 * initialisation of the sequence is only paid when needed *)
1207 VAR argList : Sy.ExprSeq;
1208 callExp : Sy.Expr;
1209 qualId : Sy.Expr;
1210 callNew : StatDesc.ProcCall;
1211 BEGIN
1212 Get;
1213 callNew := StatDesc.newProcCall();
1214 ActualParameters(argList, inhSc);
1215 qualId := Xp.mkIdLeaf(Bi.newPd);
1216 callExp := Xp.newCallX(Xp.prCall, argList, qualId);
1217 callExp.tSpan := S.mkSpanTT(callNew.token, S.prevTok);
1218 callNew.expr := callExp;
1219 RETURN callNew;
1220 END newStatement;
1221
1222 (* ------------------------- *)
1223
1224 BEGIN
1225 keywordTk := nextT;
1226 IF in(symSet[9], nextT.sym) THEN
1227 CASE nextT.sym OF
1228 | T.identSym:
1229 synthStat := identStatement(inhLp, inhSc);
1230 | T.LOOPSym:
1231 synthStat := loopStatement(inhSc);
1232 | T.IFSym:
1233 synthStat := ifStatement(inhLp, inhSc);
1234 | T.CASESym:
1235 synthStat := caseStatement(inhLp, inhSc);
1236 | T.WHILESym:
1237 synthStat := whileStatement(inhLp, inhSc);
1238 | T.REPEATSym:
1239 synthStat := repeatStatement(inhLp, inhSc);
1240 | T.FORSym:
1241 synthStat := forStatement(inhLp, inhSc);
1242 | T.WITHSym:
1243 synthStat := withStatement(inhLp, inhSc);
1244 | T.NEWSym :
1245 synthStat := newStatement(inhSc);
1246 | T.EXITSym:
1247 (* Semantic action is inline *)
1248 Get;
1249 synthStat := StatDesc.newExitS(inhLp);
1250 IF inhLp = NIL THEN SemError(58) END;
1251 | T.RETURNSym :
1252 (* Semantic action is inline *)
1253 Get;
1254 IF in(symSet[3], nextT.sym) THEN
1255 synthExpr := expression(inhSc);
1256 ELSE
1257 synthExpr := NIL;
1258 END;
1259 synthStat := StatDesc.newReturnS(synthExpr);
1260 synthStat.token := keywordTk;
1261 ELSE synthStat := StatDesc.newEmptyS();
1262
1263 END;
1264 ELSE
1265 synthStat := StatDesc.newEmptyS();
1266 END;
1267 RETURN synthStat;
1268 END statement;
1269
1270 (* ==================================================================== *)
1271
1272 PROCEDURE statementSequence(inhLp : Sy.Stmt; inhSc : Sy.Scope) : Sy.Stmt;
1273 VAR block : StatDesc.Block;
1274 first : Sy.Stmt;
1275 BEGIN
1276 WHILE ~ (in(symSet[4], nextT.sym)) DO Error(80); Get END;
1277 first := statement(inhLp, inhSc);
1278 block := NIL;
1279 WHILE weakSeparator(22, 5, 6) DO
1280 WHILE ~ (in(symSet[4], nextT.sym)) DO Error(81); Get END;
1281 IF block = NIL THEN
1282 block := StatDesc.newBlockS(first.token);
1283 IF first.kind # StatDesc.emptyS THEN Sy.AppendStmt(block.sequ,first) END
1284 END;
1285 first := statement(inhLp, inhSc);
1286 IF first.kind # StatDesc.emptyS THEN Sy.AppendStmt(block.sequ,first) END;
1287 END;
1288 IF block = NIL THEN RETURN first ELSE RETURN block END;
1289 END statementSequence;
1290
1291 (* ==================================================================== *)
1292
1293 PROCEDURE element(defScp : Sy.Scope) : Sy.Expr;
1294 VAR rslt : Sy.Expr;
1295 xTop : Sy.Expr;
1296 dTok : S.Token;
1297 BEGIN
1298 rslt := expression(defScp);
1299 IF nextT.sym = T.pointpointSym THEN (* a range *)
1300 Get; dTok := token;
1301 xTop := expression(defScp);
1302 rslt := Xp.newBinaryT(Xp.range, rslt, xTop, dTok);;
1303 END;
1304 RETURN rslt;
1305 END element;
1306
1307 (* ==================================================================== *)
1308
1309 PROCEDURE set(defScp : Sy.Scope) : Sy.Expr;
1310 VAR rslt : Xp.SetExp;
1311 BEGIN
1312 Expect(T.lbraceSym);
1313 rslt := Xp.mkEmptySet();
1314 IF in(symSet[3], nextT.sym) THEN
1315 Sy.AppendExpr(rslt.varSeq, element(defScp));
1316 WHILE nextT.sym = T.commaSym DO
1317 Get;
1318 Sy.AppendExpr(rslt.varSeq, element(defScp));
1319 END;
1320 END;
1321 Expect(T.rbraceSym);
1322 RETURN rslt;
1323 END set;
1324
1325 (* ==================================================================== *)
1326
1327 PROCEDURE mulOperator() : INTEGER;
1328 VAR oSyn : INTEGER;
1329 BEGIN
1330 IF (nextT.sym = T.starSym) THEN
1331 Get;
1332 oSyn := Xp.mult;
1333 ELSIF (nextT.sym = T.slashSym) THEN
1334 Get;
1335 oSyn := Xp.slash;
1336 ELSIF (nextT.sym = T.DIVSym) THEN
1337 Get;
1338 oSyn := Xp.divOp;
1339 ELSIF (nextT.sym = T.MODSym) THEN
1340 Get;
1341 oSyn := Xp.modOp;
1342 ELSIF (nextT.sym = T.andSym) THEN
1343 Get;
1344 oSyn := Xp.blAnd;
1345 ELSIF (nextT.sym = T.DIV0Sym) THEN
1346 Get;
1347 oSyn := Xp.div0op;
1348 ELSIF (nextT.sym = T.REM0Sym) THEN
1349 Get;
1350 oSyn := Xp.rem0op;
1351 ELSE
1352 Error(83); oSyn := T.starSym;
1353 END;
1354 RETURN oSyn;
1355 END mulOperator;
1356
1357 (* ==================================================================== *)
1358
1359 PROCEDURE factor(scope : Sy.Scope) : Sy.Expr;
1360 VAR xSyn : Sy.Expr;
1361 junk : Sy.ExprSeq;
1362 long : LONGINT;
1363 save : S.Token;
1364 BEGIN
1365 CASE nextT.sym OF
1366 T.lbraceSym :
1367 xSyn := set(scope);
1368 | T.lparenSym :
1369 Get;
1370 xSyn := expression(scope);
1371 Expect(T.rparenSym);
1372 | T.integerSym :
1373 Get;
1374 xSyn := Xp.mkNumLt(S.tokToLong(token));
1375 | T.realSym :
1376 Get;
1377 xSyn := Xp.mkRealLt(S.tokToReal(token));
1378 | T.CharConstantSym :
1379 Get;
1380 xSyn := Xp.mkCharLt(S.tokToChar(token));
1381 | T.stringSym :
1382 Get;
1383 xSyn := Xp.tokToStrLt(token.pos, token.len);
1384 | T.bangStrSym :
1385 Get;
1386 xSyn := Xp.translateStrLt(token.pos, token.len);
1387 | T.NILSym :
1388 Get;
1389 xSyn := Xp.mkNilX();
1390 | T.identSym :
1391 xSyn := designator(scope);
1392 ConvertOverloaded(xSyn);
1393 IF (xSyn # NIL) & (xSyn.kind = Xp.prCall) THEN
1394 SemError(24); (* use of proper proc as function *)
1395 END;
1396 | T.tildeSym :
1397 Get;
1398 xSyn := factor(scope);
1399 xSyn := Xp.newUnaryX(Xp.blNot, xSyn);
1400 ELSE
1401 Error(84); xSyn := NIL;
1402 END;
1403 RETURN xSyn;
1404 END factor;
1405
1406 (* ==================================================================== *)
1407
1408 PROCEDURE addOperator() : INTEGER;
1409 VAR oSyn : INTEGER;
1410 BEGIN
1411 IF (nextT.sym = T.plusSym) THEN
1412 Get;
1413 oSyn := Xp.plus;
1414 ELSIF (nextT.sym = T.minusSym) THEN
1415 Get;
1416 oSyn := Xp.minus;
1417 ELSIF (nextT.sym = T.ORSym) THEN
1418 Get;
1419 oSyn := Xp.blOr;
1420 ELSE
1421 Error(85); oSyn := T.plusSym;
1422 END;
1423 RETURN oSyn;
1424 END addOperator;
1425
1426 (* ==================================================================== *)
1427
1428 PROCEDURE term(scope : Sy.Scope) : Sy.Expr;
1429 VAR xSyn1 : Sy.Expr;
1430 xSyn2 : Sy.Expr;
1431 mulOp : INTEGER;
1432 saveT : S.Token;
1433 BEGIN
1434 xSyn1 := factor(scope);
1435 WHILE (nextT.sym = T.starSym) OR
1436 (nextT.sym = T.slashSym) OR
1437 (nextT.sym = T.DIVSym) OR
1438 (nextT.sym = T.MODSym) OR
1439 (nextT.sym = T.DIV0Sym) OR
1440 (nextT.sym = T.REM0Sym) OR
1441 (nextT.sym = T.andSym) DO
1442 mulOp := mulOperator(); saveT := token;
1443 xSyn2 := factor(scope);
1444 xSyn1 := Xp.newBinaryT(mulOp, xSyn1, xSyn2, saveT);
1445 END;
1446 RETURN xSyn1;
1447 END term;
1448
1449 (* ==================================================================== *)
1450
1451 PROCEDURE relation() : INTEGER;
1452 VAR oSyn : INTEGER;
1453 BEGIN
1454 CASE nextT.sym OF
1455 | T.equalSym :
1456 Get; oSyn := Xp.equal;
1457 | T.hashSym :
1458 Get; oSyn := Xp.notEq;
1459 | T.lessSym :
1460 Get; oSyn := Xp.lessT;
1461 | T.lessequalSym :
1462 Get; oSyn := Xp.lessEq;
1463 | T.greaterSym :
1464 Get; oSyn := Xp.greT;
1465 | T.greaterequalSym :
1466 Get; oSyn := Xp.greEq;
1467 | T.INSym :
1468 Get; oSyn := Xp.inOp;
1469 | T.ISSym :
1470 Get; oSyn := Xp.isOp;
1471 ELSE
1472 Error(86); oSyn := Xp.equal;
1473 END;
1474 RETURN oSyn;
1475 END relation;
1476
1477 (* ==================================================================== *)
1478
1479 PROCEDURE simpleExpression(scope : Sy.Scope) : Sy.Expr;
1480 VAR opNeg : BOOLEAN;
1481 addOp : INTEGER;
1482 term1 : Sy.Expr;
1483 term2 : Sy.Expr;
1484 saveT : S.Token;
1485 BEGIN
1486 opNeg := FALSE;
1487 IF nextT.sym = T.minusSym THEN
1488 Get; opNeg := TRUE;
1489 ELSIF nextT.sym = T.plusSym THEN
1490 Get;
1491 END;
1492 term1 := term(scope);
1493 IF opNeg THEN term1 := Xp.newUnaryX(Xp.neg, term1) END;
1494 WHILE (nextT.sym = T.minusSym) OR
1495 (nextT.sym = T.plusSym) OR
1496 (nextT.sym = T.ORSym) DO
1497 addOp := addOperator(); saveT := token;
1498 term2 := term(scope);
1499 term1 := Xp.newBinaryT(addOp, term1, term2, saveT);
1500 END;
1501 RETURN term1;
1502 END simpleExpression;
1503
1504 (* ==================================================================== *)
1505
1506 PROCEDURE OptExprList(VAR xList : Sy.ExprSeq; inhScp : Sy.Scope);
1507 BEGIN
1508 IF in(symSet[3], nextT.sym) THEN
1509 ExprList(xList, inhScp);
1510 ELSE (* empty list *)
1511 xList.ResetTo(0);
1512 END;
1513 END OptExprList;
1514
1515 (* ==================================================================== *)
1516
1517 PROCEDURE ExprList(VAR xList : Sy.ExprSeq; inhScp : Sy.Scope);
1518 BEGIN
1519 (*
1520 * To avoid aliassing, ALWAYS Discard old sequence.
1521 *)
1522 Sy.InitExprSeq(xList, 4);
1523 Sy.AppendExpr(xList, expression(inhScp));
1524 WHILE (nextT.sym = T.commaSym) DO
1525 Get;
1526 Sy.AppendExpr(xList, expression(inhScp));
1527 END;
1528 END ExprList;
1529
1530 (* ==================================================================== *)
1531
1532 PROCEDURE findMatchingProcs(oId : Id.OvlId;
1533 actuals : Sy.ExprSeq;
1534 VAR rslt : Id.PrcSeq);
1535 VAR
1536 index : INTEGER;
1537 visited : Id.PrcSeq;
1538 rec : Ty.Record;
1539 id : Sy.Idnt;
1540 prcTy : Ty.Procedure;
1541 finished : BOOLEAN;
1542
1543 PROCEDURE seen(newP : Ty.Procedure; visited : Id.PrcSeq) : BOOLEAN;
1544 VAR
1545 index : INTEGER;
1546 BEGIN
1547 FOR index := 0 TO visited.tide-1 DO
1548 IF newP.sigsMatch(visited.a[index].type) THEN RETURN TRUE; END;
1549 END;
1550 RETURN FALSE;
1551 END seen;
1552
1553 BEGIN
1554 Id.InitPrcSeq(rslt,1);
1555 Id.InitPrcSeq(visited,5);
1556 rec := oId.rec(Ty.Record);
1557 id := oId;
1558 finished := id = NIL;
1559 WHILE ~finished & (id # NIL) DO
1560 WITH id : Id.OvlId DO
1561 FOR index := 0 TO id.list.tide-1 DO
1562 prcTy := id.list.a[index].type(Ty.Procedure);
1563 IF Xp.MatchPars(prcTy.formals,actuals) & ~seen(prcTy,rslt) THEN
1564 Id.AppendProc(rslt,id.list.a[index]);
1565 END;
1566 END;
1567 | id : Id.Procs DO
1568 prcTy := id.type(Ty.Procedure);
1569 IF Xp.MatchPars(prcTy.formals,actuals) & ~seen(prcTy,rslt) THEN
1570 Id.AppendProc(rslt,id);
1571 END;
1572 finished := TRUE;
1573 ELSE
1574 finished := TRUE;
1575 END;
1576 IF (rec.baseTp = NIL) OR (rec.baseTp = Ty.anyRecTp) THEN
1577 finished := TRUE;
1578 ELSE
1579 rec := rec.baseTp.boundRecTp()(Ty.Record);
1580 id := rec.symTb.lookup(oId.hash);
1581 END;
1582 END;
1583 END findMatchingProcs;
1584
1585 PROCEDURE FindBestMatch(IN actuals : Sy.ExprSeq; IN procs : Id.PrcSeq;
1586 OUT match : BOOLEAN; OUT ix : INTEGER);
1587 VAR pIx : INTEGER;
1588 pTy : Ty.Procedure;
1589
1590 PROCEDURE IsSameAs(lhs : Sy.Type; rhs : Sy.Type) : BOOLEAN;
1591 BEGIN
1592 IF lhs = rhs THEN RETURN TRUE;
1593 ELSE RETURN lhs.equalType(rhs);
1594 END;
1595 END IsSameAs;
1596
1597 PROCEDURE IsSameWithNativeCoercions(lhs : Sy.Type; rhs : Sy.Type) : BOOLEAN;
1598 BEGIN
1599 IF lhs = rhs THEN RETURN TRUE;
1600 ELSIF lhs.isStringType() & rhs.isStringType() THEN RETURN TRUE;
1601 ELSIF lhs.isNativeObj() & rhs.isNativeObj() THEN RETURN TRUE;
1602 ELSE RETURN lhs.equalType(rhs);
1603 END;
1604 END IsSameWithNativeCoercions;
1605
1606
1607
1608 BEGIN
1609 match := FALSE;
1610 ix := 0;
1611 WHILE ~match & (ix < procs.tide) DO
1612 pIx := 0; match := TRUE;
1613 WHILE match & (pIx < actuals.tide) DO
1614 pTy := procs.a[ix].type(Ty.Procedure);
1615 match := IsSameAs(actuals.a[pIx].type, pTy.formals.a[pIx].type);
1616 INC(pIx);
1617 END;
1618 IF ~match THEN INC(ix) ELSE RETURN END;
1619 END;
1620 ix := 0;
1621 WHILE ~match & (ix < procs.tide) DO
1622 pIx := 0; match := TRUE;
1623 WHILE match & (pIx < actuals.tide) DO
1624 pTy := procs.a[ix].type(Ty.Procedure);
1625 match := IsSameWithNativeCoercions(actuals.a[pIx].type, pTy.formals.a[pIx].type);
1626 INC(pIx);
1627 END;
1628 IF ~match THEN INC(ix) END;
1629 END;
1630 IF ~match THEN ix := 0 END;
1631 END FindBestMatch;
1632
1633 (* ==================================================================== *)
1634
1635 PROCEDURE makeCall(xCr : Sy.Expr;
1636 IN actuals : Sy.ExprSeq;
1637 inhScp : Sy.Scope) : Sy.Expr;
1638 VAR
1639 procs : Id.PrcSeq;
1640 moreThanOne, found : BOOLEAN;
1641 oId : Id.OvlId;
1642 prcTy : Ty.Procedure;
1643 index, pIx, err : INTEGER;
1644 nam : LitValue.CharOpen;
1645
1646 (* ------------------------- *)
1647
1648 PROCEDURE RepMulErr(eNo : INTEGER;
1649 pNam : LitValue.CharOpen;
1650 frmSeq : Id.ParSeq);
1651 VAR
1652 ix : INTEGER;
1653 len : INTEGER;
1654 par : Id.ParId;
1655 cSeq : LitValue.CharOpenSeq;
1656
1657 BEGIN
1658 LitValue.InitCharOpenSeq(cSeq,3);
1659 LitValue.AppendCharOpen(cSeq,pNam);
1660 LitValue.AppendCharOpen(cSeq,LitValue.strToCharOpen("("));
1661 len := frmSeq.tide - 1;
1662 FOR ix := 0 TO len DO
1663 par := frmSeq.a[ix];
1664 LitValue.AppendCharOpen(cSeq,par.type.name());
1665 IF ix < len THEN LitValue.AppendCharOpen(cSeq,comma) END;
1666 END;
1667 LitValue.AppendCharOpen(cSeq,LitValue.strToCharOpen(")"));
1668 S.SemError.RepSt1(eNo, LitValue.arrayCat(cSeq)^, token.lin, 0);
1669 END RepMulErr;
1670
1671 (* ------------------------- *)
1672
1673 PROCEDURE CheckSuper(xIn : Xp.IdentX);
1674 VAR fld : Sy.Idnt; (* Selector identifier *)
1675 sId : Sy.Idnt; (* Super method ident *)
1676 mth : Id.MthId; (* Method identifier *)
1677 rcT : Ty.Record; (* Method bound recType *)
1678 BEGIN
1679 fld := xIn.ident;
1680 (*
1681 * Console.WriteLn;
1682 * fld.Diagnose(0);
1683 * Console.WriteLn;
1684 *)
1685 IF (fld.kind # Id.conMth) & (fld.kind # Id.fwdMth) THEN
1686 SemError(119); (* super call invalid *)
1687 ELSE (* OK, fld is a method *)
1688 (* Find the receiver type, and check in scope of base type. *)
1689 mth := fld(Id.MthId);
1690 rcT := mth.bndType(Ty.Record);
1691 IF (rcT # NIL) &
1692 (rcT.baseTp # NIL) &
1693 (rcT.baseTp.kind = Ty.recTp) THEN
1694 (*
1695 * Bind to the overridden method, not necessarily
1696 * defined in the immediate supertype.
1697 *)
1698 sId := rcT.baseTp(Ty.Record).bindField(fld.hash);
1699 (*
1700 * Inherited method could be overloaded
1701 * Find single sId that matches mth
1702 *)
1703 IF (sId # NIL) & (sId IS Id.OvlId) THEN
1704 sId := sId(Id.OvlId).findProc(mth);
1705 (*
1706 * IF sId # NIL THEN
1707 * Console.WriteLn;
1708 * sId.Diagnose(0);
1709 * Console.WriteLn;
1710 * END;
1711 *)
1712 END;
1713 (*
1714 * Now check various semantic constraints
1715 *)
1716 IF (sId # NIL) & (sId IS Id.MthId) THEN
1717 IF sId(Id.MthId).mthAtt * Id.mask # Id.extns THEN
1718 SemError(118); (* call empty or abstract *)
1719 ELSE
1720 xIn.ident := sId;
1721 xIn.type := sId.type;
1722 END;
1723 ELSE
1724 SemError(120); (* unknown super method *)
1725 END;
1726 ELSE
1727 SemError(120); (* unknown super method *)
1728 END;
1729 END;
1730 END CheckSuper;
1731
1732 (* ------------------------- *)
1733 BEGIN
1734 moreThanOne := FALSE;
1735 IF (xCr = NIL) OR (xCr.type = NIL) OR (xCr IS Xp.CallX) THEN
1736 RETURN xCr;
1737 END;
1738 pIx := 0;
1739 IF xCr.type.kind = Ty.ovlTp THEN
1740 oId := xCr.type.idnt(Id.OvlId);
1741 nam := Sy.getName.ChPtr(oId);
1742 Xp.AttributePars(actuals);
1743 findMatchingProcs(oId,actuals,procs);
1744 IF procs.tide = 0 THEN
1745 SemError(218);
1746 RETURN NIL;
1747 ELSIF procs.tide > 1 THEN
1748 FindBestMatch(actuals,procs,found,pIx);
1749 IF ~found THEN err := 220 ELSE err := 312 END;
1750 FOR index := 0 TO procs.tide-1 DO
1751 IF ~(found & (index = pIx)) THEN (* just for info *)
1752 RepMulErr(err,nam,procs.a[index].type(Ty.Procedure).formals);
1753 END;
1754 END;
1755 IF found THEN
1756 RepMulErr(313,nam,procs.a[pIx].type(Ty.Procedure).formals);
1757 SemError(307);
1758 ELSE
1759 SemError(219);
1760 RETURN NIL;
1761 END;
1762 END;
1763 WITH xCr : Xp.IdLeaf DO
1764 xCr.ident := procs.a[pIx];
1765 xCr.type := xCr.ident.type;
1766 | xCr : Xp.IdentX DO
1767 xCr.ident := procs.a[pIx];
1768 xCr.type := xCr.ident.type;
1769 END;
1770 END;
1771 (*
1772 * Overloading (if any) is by now resolved.
1773 * Now check for super calls. See if
1774 * we can find a match for xCr.ident
1775 * in the supertype of
1776 * - xCr.kid.ident(Id.MthId).bndType
1777 *)
1778 IF xCr.kind = Xp.sprMrk THEN
1779 CheckSuper(xCr(Xp.IdentX));
1780 END;
1781 (*
1782 * Now create CallX node in tree.
1783 *)
1784 IF (xCr.type.kind # Ty.prcTp) &
1785 (xCr.type.kind # Ty.evtTp) THEN
1786 xCr.ExprError(224); RETURN NIL;
1787 ELSIF xCr.type.isProperProcType() THEN
1788 xCr := Xp.newCallX(Xp.prCall, actuals, xCr);
1789 xCr.NoteCall(inhScp); (* note "inhScp" calls "eSyn.kid" *)
1790 ELSE
1791 xCr := Xp.newCallX(Xp.fnCall, actuals, xCr);
1792 xCr := Xp.checkCall(xCr(Xp.CallX));
1793 IF (xCr # NIL) THEN
1794 xCr.NoteCall(inhScp); (* note "inhScp" calls "eSyn.kid" *)
1795 IF (xCr IS Xp.CallX) & (xCr(Xp.CallX).kid.kind = Xp.sprMrk) THEN
1796 Xp.CheckSuper(xCr(Xp.CallX), inhScp);
1797 END;
1798 END;
1799 END;
1800 RETURN xCr;
1801 END makeCall;
1802
1803 (* ------------------------- *)
1804
1805 PROCEDURE findFieldId(id : Id.OvlId) : Sy.Idnt;
1806 VAR
1807 fId : Sy.Idnt;
1808 rec : Ty.Record;
1809 ident : Sy.Idnt;
1810 BEGIN
1811 IF id = NIL THEN RETURN NIL END;
1812 fId := id.fld;
1813 rec := id.rec(Ty.Record);
1814 WHILE (fId = NIL) & (rec.baseTp # NIL) & (rec.baseTp IS Ty.Record) DO
1815 rec := rec.baseTp(Ty.Record);
1816 ident := rec.symTb.lookup(id.hash);
1817 IF ident IS Id.OvlId THEN
1818 fId := ident(Id.OvlId).fld;
1819 ELSIF (ident.kind = Id.fldId) OR (ident.kind = Id.varId) OR
1820 (ident.kind = Id.conId) THEN
1821 fId := ident;
1822 END;
1823 END;
1824 RETURN fId;
1825 END findFieldId;
1826
1827 (* ------------------------- *)
1828
1829 PROCEDURE FindOvlField(e : Sy.Expr);
1830 BEGIN
1831 ASSERT(e.type.kind = Ty.ovlTp);
1832 WITH e : Xp.IdentX DO
1833 e.ident := findFieldId(e.ident(Id.OvlId));
1834 IF e.ident = NIL THEN
1835 e.ExprError(9);
1836 ELSE
1837 e.type := e.ident.type;
1838 END;
1839 | e : Xp.IdLeaf DO
1840 e.ident := findFieldId(e.ident(Id.OvlId));
1841 IF e.ident = NIL THEN
1842 e.ExprError(9);
1843 ELSE
1844 e.type := e.ident.type;
1845 END;
1846 END;
1847 END FindOvlField;
1848
1849 (* ------------------------- *)
1850
1851 PROCEDURE ConvertOverloaded(VAR e : Sy.Expr);
1852 BEGIN
1853 IF (e # NIL) & (e.type IS Ty.Overloaded) THEN
1854 (*
1855 * WITH e : Xp.IdentX DO
1856 * e.ident := e.ident(Id.OvlId).fld;
1857 * IF (e.ident = NIL) THEN
1858 * SemErrorT(9, e.token);
1859 * ELSE
1860 * e.type := e.ident.type;
1861 * END;
1862 * END;
1863 *)
1864 WITH e : Xp.IdentX DO
1865 e.ident := e.ident(Id.OvlId).fld;
1866 IF (e.ident = NIL) THEN
1867 SemErrorT(9, e.token);
1868 ELSE
1869 e.type := e.ident.type;
1870 END;
1871 | e : Xp.IdLeaf DO
1872 e.ident := e.ident(Id.OvlId).fld;
1873 IF (e.ident = NIL) THEN
1874 SemErrorT(9, e.token);
1875 ELSE
1876 e.type := e.ident.type;
1877 END;
1878 END;
1879 END;
1880 END ConvertOverloaded;
1881
1882 (* ==================================================================== *)
1883
1884 PROCEDURE MethAttributes(pDesc : Id.Procs);
1885 VAR mAtt : SET;
1886 hash : INTEGER;
1887 (* ------------------------- *)
1888 PROCEDURE CheckBasecall(proc : Id.Procs);
1889 VAR idx : INTEGER;
1890 rec : Sy.Type;
1891 bRc : Ty.Record;
1892 sId : Sy.Idnt;
1893 bas : Id.BaseCall;
1894 sTp : Ty.Procedure;
1895 seq : Id.PrcSeq;
1896 mOk : BOOLEAN;
1897 BEGIN
1898 bRc := NIL;
1899 bas := proc.basCll;
1900 rec := proc.type.returnType();
1901 IF rec # NIL THEN rec := rec.boundRecTp(); bRc := rec(Ty.Record) END;
1902 IF rec # NIL THEN rec := rec(Ty.Record).baseTp END;
1903 IF rec # NIL THEN rec := rec.boundRecTp() END;
1904 (*
1905 * Compute the apparent type of each actual.
1906 *)
1907 FOR idx := 0 TO bas.actuals.tide - 1 DO
1908 bas.actuals.a[idx] := bas.actuals.a[idx].exprAttr();
1909 END;
1910 (*
1911 * Now try to find matching super-ctor.
1912 * IF there are not actuals, then assume the existence of
1913 * a noarg constructor. TypeDesc.okToList will check this!
1914 *)
1915 IF bas.actuals.tide # 0 THEN
1916 WITH rec : Ty.Record DO
1917 FOR idx := 0 TO rec.statics.tide - 1 DO
1918 sId := rec.statics.a[idx];
1919 (*
1920 * If this is a .ctor, then try to match arguments ...
1921 *)
1922 IF sId.kind = Id.ctorP THEN
1923 sTp := sId.type(Ty.Procedure);
1924 IF Xp.MatchPars(sTp.formals, bas.actuals) THEN
1925 Id.AppendProc(seq, sId(Id.Procs));
1926 END;
1927 END;
1928 END;
1929 END;
1930 ELSE
1931 Id.AppendProc(seq, NIL);
1932 END;
1933 IF seq.tide = 0 THEN SemError(202);
1934 ELSIF seq.tide = 1 THEN bas.sprCtor := seq.a[0];
1935 ELSE
1936 FindBestMatch(bas.actuals, seq, mOk, idx);
1937 IF mOk THEN bas.sprCtor := seq.a[idx] ELSE SemError(147) END;
1938 END;
1939 IF bRc # NIL THEN
1940 Sy.AppendIdnt(bRc.statics, proc);
1941 (*
1942 * And, while we are at it, if this is a no-arg
1943 * constructor, suppress emission of the default.
1944 *)
1945 IF proc.locals.tide = 1 THEN INCL(bRc.xAttr, Sy.xCtor) END;
1946 END;
1947 END CheckBasecall;
1948 (* ------------------------- *)
1949 PROCEDURE DummyParameters(VAR seq : Sy.ExprSeq; prT : Ty.Procedure);
1950 VAR idx : INTEGER;
1951 idl : Xp.IdLeaf;
1952 BEGIN
1953 FOR idx := 0 TO prT.formals.tide - 1 DO
1954 idl := Xp.mkIdLeaf(prT.formals.a[idx]);
1955 idl.type := idl.ident.type;
1956 Sy.AppendExpr(seq, idl);
1957 END;
1958 END DummyParameters;
1959 (* ------------------------- *)
1960 PROCEDURE InsertSelf(prc : Id.Procs);
1961 VAR par : Id.ParId;
1962 tmp : Sy.IdSeq;
1963 idx : INTEGER;
1964 BEGIN
1965 par := Id.newParId();
1966 par.hash := Bi.selfBk;
1967 par.dfScp := prc;
1968 par.parMod := Sy.in; (* so it is read only *)
1969 par.varOrd := 0; (* both .NET and JVM *)
1970 par.type := prc.type.returnType();
1971 ASSERT(prc.symTb.enter(par.hash, par));
1972 (*
1973 * Now adjust the locals sequence.
1974 *)
1975 Sy.AppendIdnt(tmp, par);
1976 FOR idx := 0 TO prc.locals.tide-1 DO
1977 Sy.AppendIdnt(tmp, prc.locals.a[idx]);
1978 prc.locals.a[idx](Id.AbVar).varOrd := idx+1;
1979 END;
1980 prc.locals := tmp;
1981 END InsertSelf;
1982 (* ------------------------- *)
1983 BEGIN
1984 mAtt := {};
1985 IF nextT.sym = T.NEWSym THEN
1986 Get;
1987 mAtt := Id.isNew;
1988 IF nextT.sym = T.commaSym THEN Get; mAtt := otherAtts(mAtt) END;
1989 ELSIF nextT.sym = T.identSym THEN
1990 hash := NameHash.enterSubStr(nextT.pos, nextT.len);
1991 IF (hash = Bi.constB) OR (hash = Bi.basBkt) THEN
1992 Get;
1993 IF Cs.strict THEN SemError(221); END;
1994 NEW(pDesc.basCll);
1995 IF hash = Bi.basBkt THEN
1996 pDesc.basCll.empty := FALSE;
1997 ActualParameters(pDesc.basCll.actuals, pDesc);
1998 (*
1999 * Insert the arg0 identifier "SELF"
2000 *)
2001 InsertSelf(pDesc);
2002 ELSE
2003 pDesc.basCll.empty := TRUE;
2004 DummyParameters(pDesc.basCll.actuals, pDesc.type(Ty.Procedure));
2005 END;
2006 CheckBasecall(pDesc);
2007 pDesc.SetKind(Id.ctorP);
2008 END;
2009 ELSIF (nextT.sym = T.ABSTRACTSym) OR
2010 (nextT.sym = T.EXTENSIBLESym) OR
2011 (nextT.sym = T.EMPTYSym) THEN
2012 mAtt := otherAtts({});
2013 ELSE
2014 Error(78);
2015 END;
2016 IF pDesc IS Id.MthId THEN
2017 pDesc(Id.MthId).mthAtt := mAtt;
2018 IF pDesc.kind = Id.ctorP THEN SemError(146) END;
2019 ELSIF pDesc.kind # Id.ctorP THEN
2020 SemError(61);
2021 END;
2022 END MethAttributes;
2023
2024 (* ==================================================================== *)
2025
2026 PROCEDURE getTypeAssertId(lst : Sy.ExprSeq) : Sy.Idnt;
2027 VAR
2028 lf : Xp.IdLeaf;
2029 BEGIN
2030 IF (lst.tide = 1) & (lst.a[0] IS Xp.IdLeaf) THEN
2031 lf := lst.a[0](Xp.IdLeaf);
2032 IF lf.ident IS Id.TypId THEN RETURN lf.ident; END;
2033 END;
2034 RETURN NIL;
2035 END getTypeAssertId;
2036
2037 (* ==================================================================== *)
2038
2039 PROCEDURE designator(inhScp : Sy.Scope) : Sy.Expr;
2040 VAR eSyn : Sy.Expr; (* the synthesized expression attribute *)
2041 qual : Sy.Idnt; (* the base qualident of the designator *)
2042 iLst : Sy.ExprSeq; (* a list of array index expressions *)
2043 exTp : Sy.Type;
2044 isTp : BOOLEAN;
2045
2046 (* ------------------------- *)
2047
2048 PROCEDURE implicitDerefOf(wrkX : Sy.Expr) : Sy.Expr;
2049 (* Make derefs explicit, returning NIL if invalid pointer type. *)
2050 VAR wrkT : Sy.Type;
2051 bndT : Sy.Type;
2052 save : S.Token;
2053 BEGIN
2054 IF (wrkX # NIL) &
2055 (wrkX.type # NIL) THEN
2056 wrkT := wrkX.type;
2057 WITH wrkT : Ty.Pointer DO
2058 bndT := wrkT.boundTp;
2059 IF bndT = NIL THEN RETURN NIL END;
2060 save := wrkX.token;
2061 wrkX := Xp.newUnaryX(Xp.deref, wrkX);
2062 wrkX.token := save; (* point to the same token *)
2063 wrkX.type := bndT; (* type is bound type of ptr. *)
2064 | wrkT : Ty.Base DO
2065 IF wrkT = Ty.anyPtrTp THEN
2066 save := wrkX.token;
2067 wrkX := Xp.newUnaryX(Xp.deref, wrkX);
2068 wrkX.token := save;
2069 wrkX.type := Ty.anyRecTp;
2070 END;
2071 | wrkT : Ty.Event DO
2072 wrkX.type := wrkT.bndRec;
2073 ELSE (* skip *)
2074 END;
2075 END;
2076 RETURN wrkX;
2077 END implicitDerefOf;
2078
2079 (* ------------------------- *)
2080
2081 PROCEDURE checkRecord(xIn : Sy.Expr; (* referencing expression *)
2082 tok : S.Token; (* field/procedure ident *)
2083 scp : Sy.Scope; (* current scope of ref. *)
2084 tId : BOOLEAN) : Sy.Expr; (* left context is tp *)
2085 VAR fId : Sy.Idnt; (* the field identifier desc. *)
2086 xNw : Sy.Expr;
2087 (* ------------------------- *)
2088 PROCEDURE Rep162(f : Sy.Idnt);
2089 BEGIN SemErrorS1(162, Sy.getName.ChPtr(f)) END Rep162;
2090 (* ------------------------- *)
2091 BEGIN (* quit at first trouble sign *)
2092 ConvertOverloaded(xIn);
2093 xNw := implicitDerefOf(xIn);
2094 IF (xNw = NIL) OR (xNw.type = NIL) THEN RETURN NIL END;
2095 IF (xNw.type.kind # Ty.recTp) &
2096 (xNw.type.kind # Ty.enuTp) THEN SemError(8); RETURN NIL END;
2097 fId := bindFieldToken(xNw.type, tok);
2098 IF fId = NIL THEN
2099 SemErrorS1(9, xIn.type.name()); RETURN NIL;
2100 ELSE
2101 IF tId THEN (* fId must be a foreign, static feature! *)
2102 IF fId IS Id.FldId THEN SemError(196) END;
2103 IF fId IS Id.MthId THEN SemError(197) END;
2104 xNw := Xp.mkIdLeaf(fId);
2105 ELSE
2106 WITH fId : Id.VarId DO SemError(198);
2107 | fId : Id.PrcId DO SemError(199);
2108 | fId : Id.MthId DO
2109 IF fId.callForbidden() THEN SemErrorT(127, tok) END;
2110 (*
2111 * IF (fId.vMod = Sy.rdoMode) &
2112 * xNw.type.isImportedType() THEN SemErrorT(127, tok) END;
2113 *)
2114
2115 ELSE (* skip *)
2116 END;
2117 xNw := Xp.newIdentX(Xp.selct, fId, xNw);
2118 END;
2119 IF fId.vMod = Sy.protect THEN
2120 (*
2121 * If fId is a protected feature (and hence
2122 * foreign) then the context must be a method
2123 * body. Furthermore, the method scope must
2124 * be derived from the field's defining scope.
2125 *)
2126 WITH scp : Id.MthId DO
2127 IF ~xIn.type.isBaseOf(scp.rcvFrm.type) THEN Rep162(fId) END;
2128 ELSE
2129 Rep162(fId);
2130 END;
2131 END;
2132 IF (fId.type # NIL) &
2133 (fId.type IS Ty.Opaque) THEN
2134 (* ------------------------------------------- *
2135 * Permanently fix the field type attribute.
2136 * ------------------------------------------- *)
2137 fId.type := fId.type.elaboration();
2138 END;
2139 xNw.type := fId.type;
2140 RETURN xNw;
2141 END;
2142 END checkRecord;
2143
2144 (* ------------------------- *)
2145
2146 PROCEDURE checkArray(xCr : Sy.Expr; IN seq : Sy.ExprSeq) : Sy.Expr;
2147 VAR xTp : Sy.Type; (* type of current expr xCr *)
2148 aTp : Ty.Array; (* current array type of expr *)
2149 iCr : Sy.Expr; (* the current index expression *)
2150 idx : INTEGER; (* index into expr. sequence *)
2151 tok : S.Token;
2152 BEGIN (* quit at first trouble sign *)
2153 ConvertOverloaded(xCr);
2154 tok := xCr.token;
2155 FOR idx := 0 TO seq.tide-1 DO
2156 xCr := implicitDerefOf(xCr);
2157 IF xCr # NIL THEN xTp := xCr.type ELSE RETURN NIL END;
2158 (* ----------- *
2159 * IF xTp.kind # Ty.arrTp THEN
2160 * IF idx = 0 THEN xCr.ExprError(10) ELSE xCr.ExprError(11) END;
2161 * RETURN NIL;
2162 * ELSE
2163 * aTp := xTp(Ty.Array);
2164 * END;
2165 * ----------- *)
2166 WITH xTp : Ty.Array DO
2167 aTp := xTp(Ty.Array);
2168 ELSE
2169 IF idx = 0 THEN xCr.ExprError(10) ELSE xCr.ExprError(11) END;
2170 RETURN NIL;
2171 END;
2172 (* ----------- *)
2173 xTp := aTp.elemTp;
2174 iCr := seq.a[idx];
2175 IF iCr # NIL THEN iCr := iCr.exprAttr() END;
2176 IF iCr # NIL THEN (* check is integertype , literal in range *)
2177 IF ~iCr.isIntExpr() THEN iCr.ExprError(31) END;
2178 IF iCr.type = Bi.lIntTp THEN
2179 iCr := Xp.newIdentX(Xp.cvrtDn, Bi.intTp.idnt, iCr);
2180 END;
2181 IF iCr.isNumLit() & ~iCr.inRangeOf(aTp) THEN iCr.ExprError(32) END;
2182 tok := iCr.token;
2183 END;
2184 xCr := Xp.newBinaryT(Xp.index, xCr, iCr, tok);
2185 IF xTp # NIL THEN xCr.type := xTp ELSE RETURN NIL END;
2186 END;
2187 RETURN xCr;
2188 END checkArray;
2189
2190 (* ------------------------- *)
2191
2192 PROCEDURE checkTypeAssert(xpIn : Sy.Expr; tpId : Sy.Idnt) : Sy.Expr;
2193 VAR dstT : Sy.Type;
2194 recT : Ty.Record;
2195 BEGIN
2196 IF xpIn.type.kind = Ty.ovlTp THEN FindOvlField(xpIn); END;
2197 IF (xpIn = NIL) OR (tpId = NIL) OR (tpId.type = NIL) THEN RETURN NIL END;
2198 dstT := tpId.type;
2199 recT := dstT.boundRecTp()(Ty.Record);
2200 (* Check #1 : qualident must be a [possibly ptr to] record type *)
2201 IF recT = NIL THEN SemError(18); RETURN NIL END;
2202 (* Check #2 : Check that the expression has some dynamic type *)
2203 IF ~xpIn.hasDynamicType() THEN xpIn.ExprError(17); RETURN NIL END;
2204 IF dstT.kind = Ty.recTp THEN xpIn := implicitDerefOf(xpIn) END;
2205 (* Check #3 : Check that manifest type is a base of asserted type *)
2206 IF Cs.extras THEN
2207 IF ~xpIn.type.isBaseOf(dstT) &
2208 ~xpIn.type.isInterfaceType() &
2209 ~dstT.isInterfaceType() &
2210 ~(dstT.isCompoundType() & recT.compoundCompat(xpIn.type) ) &
2211 ~dstT.isEventType() THEN SemError(15); RETURN NIL END;
2212
2213 ELSE
2214 IF ~xpIn.type.isBaseOf(dstT) &
2215 ~xpIn.type.isInterfaceType() &
2216 ~dstT.isInterfaceType() &
2217 ~dstT.isEventType() &
2218 ~Ty.isBoxedStruct(xpIn.type, dstT) THEN SemError(15); RETURN NIL END;
2219 END; (* IF Cs.extras *)
2220 (* Geez, it seems to be ok! *)
2221 xpIn := Xp.newUnaryX(Xp.tCheck, xpIn);
2222 xpIn.type := dstT;
2223 RETURN xpIn;
2224 END checkTypeAssert;
2225
2226 (* ------------------------- *)
2227
2228 PROCEDURE mkSuperCall(xIn : Sy.Expr) : Sy.Expr;
2229 VAR new : Sy.Expr;
2230 BEGIN
2231 new := NIL;
2232 WITH xIn : Xp.IdentX DO
2233 new := Xp.newIdentX(Xp.sprMrk, xIn.ident, xIn.kid);
2234 new.type := xIn.ident.type;
2235 ELSE
2236 SemError(119); (* super call invalid *)
2237 END;
2238 RETURN new;
2239 END mkSuperCall;
2240
2241 (* ------------------------- *)
2242
2243 PROCEDURE stringifier(xIn : Sy.Expr) : Sy.Expr;
2244 BEGIN
2245 xIn := implicitDerefOf(xIn);
2246 IF xIn.isCharArray() THEN
2247 xIn := Xp.newUnaryX(Xp.mkStr, xIn);
2248 xIn.type := Bi.strTp;
2249 ELSE
2250 SemError(41); RETURN NIL;
2251 END;
2252 RETURN xIn;
2253 END stringifier;
2254
2255 (* ------------------------- *)
2256
2257 PROCEDURE explicitDerefOf(wrkX : Sy.Expr) : Sy.Expr;
2258 (* Make derefs explicit, returning NIL if invalid pointer type. *)
2259 VAR expT, bndT : Sy.Type;
2260 BEGIN
2261 expT := wrkX.type;
2262 WITH expT : Ty.Pointer DO
2263 bndT := expT.boundTp;
2264 IF bndT = NIL THEN RETURN NIL END;
2265 wrkX := Xp.newUnaryX(Xp.deref, wrkX);
2266 wrkX.type := bndT; (* type is bound type of ptr. *)
2267 | expT : Ty.Base DO
2268 IF expT = Ty.anyPtrTp THEN
2269 wrkX := Xp.newUnaryX(Xp.deref, wrkX);
2270 wrkX.type := Ty.anyRecTp; (* type is bound type of ptr. *)
2271 ELSE
2272 SemError(12); RETURN NIL; (* expr. not a pointer type *)
2273 END;
2274 | expT : Ty.Overloaded DO RETURN mkSuperCall(wrkX);
2275 | expT : Ty.Procedure DO RETURN mkSuperCall(wrkX);
2276 (*
2277 * | expT : Ty.Procedure DO
2278 * RETURN checkSuperCall(wrkX);
2279 *)
2280 ELSE
2281 SemError(12); RETURN NIL; (* expr. not a pointer type *)
2282 END;
2283 RETURN wrkX;
2284 END explicitDerefOf;
2285
2286 (* ------------------------- *)
2287
2288 PROCEDURE ReportIfOpaque(exp : Sy.Expr);
2289 BEGIN
2290 IF (exp # NIL) &
2291 (exp.type # NIL) &
2292 (exp.type.kind = Ty.namTp) &
2293 (exp.type.idnt # NIL) &
2294 (exp.type.idnt.dfScp # NIL) &
2295 exp.type.idnt.dfScp.isWeak() THEN
2296 SemErrorS1(176, Sy.getName.ChPtr(exp.type.idnt.dfScp));
2297 END;
2298 END ReportIfOpaque;
2299
2300 (* ------------------------- *)
2301
2302 BEGIN (* body of designator *)
2303 (* --------------------------------------------------------- *
2304 * First deal with the qualified identifier part. *
2305 * --------------------------------------------------------- *)
2306 qual := qualident(inhScp);
2307 IF (qual # NIL) & (qual.type # NIL) THEN
2308 eSyn := Xp.mkIdLeaf(qual);
2309 eSyn.type := qual.type;
2310 isTp := qual IS Id.TypId;
2311 ELSE
2312 eSyn := NIL;
2313 isTp := FALSE;
2314 END;
2315 (* --------------------------------------------------------- *
2316 * Now deal with each selector, in sequence, by a loop. *
2317 * It is an invariant of this loop, that if eSyn # NIL, *
2318 * the expression has a valid, non-NIL type value. *
2319 * --------------------------------------------------------- *)
2320 WHILE (nextT.sym = T.pointSym) OR
2321 (nextT.sym = T.lparenSym) OR
2322 (nextT.sym = T.lbrackSym) OR
2323 (nextT.sym = T.uparrowSym) OR
2324 (nextT.sym = T.dollarSym) DO
2325 (* ------------------------------------------------------- *
2326 * If this is an opaque, resolve it if possible
2327 * ------------------------------------------------------- *)
2328 IF (eSyn # NIL) & (eSyn.type IS Ty.Opaque) THEN
2329 eSyn.type := eSyn.type.elaboration();
2330 IF eSyn.type IS Ty.Opaque THEN ReportIfOpaque(eSyn) END;
2331 END;
2332 (* ------------------------------------------------------- *
2333 * If expr is typeName, must be static feature selection
2334 * ------------------------------------------------------- *)
2335 IF isTp &
2336 (eSyn # NIL) &
2337 (eSyn IS Xp.IdLeaf) &
2338 (nextT.sym # T.pointSym) THEN eSyn.ExprError(85) END;
2339
2340 IF nextT.sym = T.pointSym THEN
2341 (* ------------------------------------------------------- *
2342 * This must be a field selection, or a method call
2343 * ------------------------------------------------------- *)
2344 Get;
2345 Expect(T.identSym);
2346 (* Check that this is a valid record type. *)
2347 IF eSyn # NIL THEN eSyn := checkRecord(eSyn, token, inhScp, isTp) END;
2348 isTp := FALSE; (* clear the flag *)
2349 ELSIF (nextT.sym = T.lbrackSym) THEN
2350 (* ------------------------------------------------------- *
2351 * This must be a indexed selection on an array type
2352 * ------------------------------------------------------- *)
2353 Get;
2354 ExprList(iLst, inhScp);
2355 Expect(T.rbrackSym);
2356 (* Check that this is a valid array type. *)
2357 IF eSyn # NIL THEN eSyn := checkArray(eSyn, iLst) END;
2358 ELSIF (nextT.sym = T.lparenSym) THEN
2359 (* -------------------------------------------------------------- *
2360 * This could be a function/procedure call, or a type assertion *
2361 * -------------------------------------------------------------- *)
2362 Get;
2363 OptExprList(iLst, inhScp);
2364 IF eSyn # NIL THEN
2365 qual := getTypeAssertId(iLst);
2366 IF (qual # NIL) & ~eSyn.isStdFunc() THEN
2367 (*
2368 * This must be a type test, so ...
2369 *
2370 * This following test is inline in checkTypeAssert()
2371 * IF eSyn.type.kind = Ty.ovlTp THEN FindOvlField(eSyn); END;
2372 *)
2373 eSyn := checkTypeAssert(eSyn,qual);
2374 ELSIF (eSyn.type.kind = Ty.prcTp) OR
2375 (eSyn.type.kind = Ty.ovlTp) OR
2376 (eSyn.type.kind = Ty.evtTp) THEN
2377 (* A (possibly overloaded) function/procedure call *)
2378 eSyn := makeCall(eSyn, iLst, inhScp);
2379 ELSE (* A syntax error. *)
2380 SemError(13);
2381 eSyn := NIL;
2382 END;
2383 END;
2384 Expect(T.rparenSym);
2385 IF (eSyn # NIL) & (eSyn.kind = Xp.prCall) THEN RETURN eSyn; END;
2386 (* Watch it! that was a semantically selected parser action. *)
2387 ELSIF (nextT.sym = T.uparrowSym) THEN
2388 (* ------------------------------------------------------- *
2389 * This can be an explicit dereference or a super call *
2390 * ------------------------------------------------------- *)
2391 Get;
2392 IF eSyn # NIL THEN eSyn := explicitDerefOf(eSyn) END;
2393 ELSE
2394 (* ------------------------------------------------------- *
2395 * This can only be an explicit make-string operator
2396 * ------------------------------------------------------- *)
2397 Get;
2398 IF eSyn # NIL THEN eSyn := stringifier(eSyn) END;
2399 (* ------------------------------------------------------- *)
2400 END;
2401 END;
2402 (* ------------------------------------------------------- *
2403 * Some special case cleanup code for enums, opaques...
2404 * ------------------------------------------------------- *)
2405 IF eSyn # NIL THEN
2406 IF isTp THEN
2407 eSyn.type := Bi.metaTp;
2408 ELSIF eSyn.type # NIL THEN
2409 exTp := eSyn.type;
2410 WITH exTp : Ty.Enum DO
2411 eSyn.type := Bi.intTp;
2412 | exTp : Ty.Opaque DO
2413 eSyn.type := exTp.elaboration();
2414 ELSE (* skip *)
2415 END;
2416 END;
2417 END;
2418 RETURN eSyn;
2419 END designator;
2420
2421 (* ==================================================================== *)
2422
2423 PROCEDURE FixAnon(defScp : Sy.Scope; tTyp : Sy.Type; mode : INTEGER);
2424 VAR iSyn : Sy.Idnt;
2425 BEGIN
2426 IF (tTyp # NIL) & (tTyp.idnt = NIL) THEN
2427 iSyn := Id.newAnonId(tTyp.serial);
2428 iSyn.SetMode(mode);
2429 tTyp.idnt := iSyn;
2430 iSyn.type := tTyp;
2431 ASSERT(Cs.thisMod.symTb.enter(iSyn.hash, iSyn));
2432 END;
2433 END FixAnon;
2434
2435 (* ==================================================================== *)
2436
2437 PROCEDURE VariableDeclaration(defScp : Sy.Scope);
2438 VAR vSeq : Sy.IdSeq; (* idents of the shared type *)
2439 tTyp : Sy.Type; (* the shared variable type desc *)
2440 indx : INTEGER;
2441 neId : Sy.Idnt; (* temp to hold Symbols.Idnet *)
2442 vrId : Id.AbVar; (* same temp, but cast to VarId *)
2443 mOut : INTEGER; (* maximum visibility of idlist *)
2444 BEGIN
2445 IdentDefList(vSeq, defScp, Id.varId);
2446 CheckVisibility(vSeq, Sy.pubMode, mOut); (* no errors! *)
2447 Expect(T.colonSym);
2448 tTyp := type(defScp, mOut);
2449 IF mOut # Sy.prvMode THEN FixAnon(defScp, tTyp, mOut) END;
2450 (*
2451 * Expect(T.colonSym);
2452 * tTyp := type(defScp, Sy.prvMode); (* not sure about this? *)
2453 *)
2454 FOR indx := 0 TO vSeq.tide-1 DO
2455 (* this works around a bug in the JVM boot compiler (kjg 7.jan.00) *)
2456 neId := vSeq.a[indx];
2457 vrId := neId(Id.AbVar);
2458 (* ------------------------- *)
2459 vrId.type := tTyp;
2460 vrId.varOrd := defScp.locals.tide;
2461 IF Sy.refused(vrId, defScp) THEN
2462 vrId.IdError(4);
2463 ELSE
2464 Sy.AppendIdnt(defScp.locals, vrId);
2465 END;
2466 END;
2467 END VariableDeclaration;
2468
2469 (* ==================================================================== *)
2470
2471 PROCEDURE FormalParameters(thsP : Ty.Procedure;
2472 proc : Id.Procs;
2473 scpe : Sy.Scope);
2474 VAR group : Id.ParSeq;
2475 (* typId : Id.TypId; *)
2476
2477 (* --------------------------- *)
2478 PROCEDURE EnterFPs(VAR grp, seq : Id.ParSeq; pSc, sSc : Sy.Scope);
2479 VAR index : INTEGER;
2480 param : Id.ParId;
2481 BEGIN
2482 FOR index := 0 TO grp.tide-1 DO
2483 param := grp.a[index];
2484 Id.AppendParam(seq, param);
2485 IF pSc # NIL THEN
2486 IF Sy.refused(param, pSc) THEN
2487 param.IdError(20);
2488 ELSE
2489 param.varOrd := pSc.locals.tide;
2490 param.dfScp := pSc;
2491 Sy.AppendIdnt(pSc.locals, param);
2492 END;
2493 END;
2494 END;
2495 END EnterFPs;
2496 (* --------------------------- *)
2497 PROCEDURE isPrivate(t : Sy.Type) : BOOLEAN;
2498 BEGIN
2499 WITH t : Ty.Array DO
2500 RETURN isPrivate(t.elemTp);
2501 ELSE
2502 RETURN ~(t IS Ty.Base) & (t.idnt.vMod = Sy.prvMode);
2503 END;
2504 END isPrivate;
2505 (* --------------------------- *)
2506 PROCEDURE CheckRetType(tst : BOOLEAN; tok : S.Token; typ : Sy.Type);
2507 VAR bndT : Sy.Type;
2508 BEGIN
2509 IF typ = NIL THEN RETURN;
2510 ELSIF typ.kind = Ty.recTp THEN SemErrorT(78, tok);
2511 ELSIF typ.kind = Ty.arrTp THEN SemErrorT(79, tok);
2512 ELSIF typ.idnt # NIL THEN (* not anon *)
2513 IF tst & isPrivate(typ) THEN SemErrorT(151, tok) END;
2514 ELSIF typ.kind = Ty.ptrTp THEN
2515 bndT := typ(Ty.Pointer).boundTp;
2516 IF tst & (bndT # NIL) & isPrivate(bndT) THEN SemErrorT(151, tok) END;
2517 END;
2518 END CheckRetType;
2519 (* --------------------------- *)
2520 PROCEDURE ReturnType(typ : Ty.Procedure; prc : Id.Procs; scp : Sy.Scope);
2521 VAR tpRt : Sy.Type;
2522 tokn : S.Token;
2523 test : BOOLEAN;
2524 BEGIN
2525 Get; (* read past colon symbol *)
2526 tokn := nextT;
2527 tpRt := type(scp, Sy.prvMode);
2528 typ.retType := tpRt;
2529 test := ~Cs.special & (prc # NIL) & (prc.vMod = Sy.pubMode);
2530 CheckRetType(test, tokn, tpRt);
2531 END ReturnType;
2532 (* --------------------------- *)
2533 BEGIN
2534 Get; (* read past lparenSym *)
2535 IF (nextT.sym = T.identSym) OR
2536 (nextT.sym = T.INSym) OR
2537 (nextT.sym = T.VARSym) OR
2538 (nextT.sym = T.OUTSym) THEN
2539 FPSection(group, proc, scpe);
2540 EnterFPs(group, thsP.formals, proc, scpe);
2541
2542 WHILE weakSeparator(22, 10, 11) DO
2543 Id.ResetParSeq(group);
2544 FPSection(group, proc, scpe);
2545 EnterFPs(group, thsP.formals, proc, scpe);
2546 END;
2547 END;
2548 Expect(T.rparenSym);
2549 IF (nextT.sym = T.colonSym) THEN ReturnType(thsP, proc, scpe) END;
2550 END FormalParameters;
2551
2552 (* ==================================================================== *)
2553
2554 PROCEDURE CheckVisibility(seq : Sy.IdSeq; in : INTEGER; OUT out : INTEGER);
2555 VAR ix : INTEGER;
2556 id : Sy.Idnt;
2557 md : INTEGER;
2558 BEGIN
2559 out := Sy.prvMode;
2560 FOR ix := 0 TO seq.tide-1 DO
2561 id := seq.a[ix];
2562 md := id.vMod;
2563 CASE in OF
2564 | Sy.prvMode : IF md # Sy.prvMode THEN id.IdError(183) END;
2565 | Sy.pubMode :
2566 | Sy.rdoMode : IF md = Sy.pubMode THEN id.IdError(184) END;
2567 END;
2568 out := Sy.maxMode(md, out);
2569 END;
2570 END CheckVisibility;
2571
2572 (* ==================================================================== *)
2573
2574 PROCEDURE IdentDefList(OUT iSeq : Sy.IdSeq;
2575 scp : Sy.Scope;
2576 kind : INTEGER);
2577 BEGIN
2578 Sy.AppendIdnt(iSeq, identDef(scp, kind));
2579 WHILE (nextT.sym = T.commaSym) DO
2580 Get;
2581 Sy.AppendIdnt(iSeq, identDef(scp, kind));
2582 END;
2583 END IdentDefList;
2584
2585 (* ==================================================================== *)
2586
2587 PROCEDURE FieldList(recT : Ty.Record;
2588 defScp : Sy.Scope;
2589 vMod : INTEGER);
2590 VAR list : Sy.IdSeq;
2591 fTyp : Sy.Type;
2592 fDsc : Id.FldId;
2593 fIdx : INTEGER;
2594 vOut : INTEGER;
2595 BEGIN
2596 IF nextT.sym = T.identSym THEN
2597 IdentDefList(list, defScp, Id.fldId);
2598 CheckVisibility(list, vMod, vOut);
2599 Expect(T.colonSym);
2600 fTyp := type(defScp, vOut);
2601 IF vOut # Sy.prvMode THEN FixAnon(defScp, fTyp, vOut) END;
2602
2603 FOR fIdx := 0 TO list.tide-1 DO
2604 fDsc := list.a[fIdx](Id.FldId);
2605 fDsc.type := fTyp;
2606 fDsc.recTyp := recT;
2607 Sy.AppendIdnt(recT.fields, fDsc);
2608 END;
2609 END;
2610 END FieldList;
2611
2612 (* ==================================================================== *)
2613
2614 PROCEDURE FieldListSequence(recT : Ty.Record;
2615 defScp : Sy.Scope;
2616 vMod : INTEGER);
2617 VAR start : INTEGER;
2618 final : INTEGER;
2619 index : INTEGER;
2620 ident : Sy.Idnt;
2621 BEGIN
2622 start := recT.fields.tide;
2623 FieldList(recT, defScp, vMod);
2624 WHILE (nextT.sym = T.semicolonSym) DO
2625 Get;
2626 FieldList(recT, defScp, vMod);
2627 END;
2628 final := recT.fields.tide;
2629 (* now insert into the fieldname scope *)
2630 FOR index := start TO final-1 DO
2631 ident := recT.fields.a[index];
2632 IF ~recT.symTb.enter(ident.hash, ident) THEN ident.IdError(6) END;
2633 END;
2634 END FieldListSequence;
2635
2636 (* ==================================================================== *)
2637
2638 PROCEDURE StaticStuff(recT : Ty.Record;
2639 defScp : Sy.Scope;
2640 vMod : INTEGER); (* vMod ??? *)
2641 (* ----------------------------------------- *)
2642 PROCEDURE StaticProc(rec : Ty.Record; scp : Sy.Scope);
2643 VAR prcD : Id.Procs;
2644 prcT : Ty.Procedure;
2645 name : LitValue.CharOpen;
2646 oId : Id.OvlId;
2647 ok : BOOLEAN;
2648 BEGIN
2649 Get; (* read past procedureSym *)
2650 prcD := identDef(scp, Id.conPrc)(Id.Procs);
2651 prcD.SetKind(Id.conPrc);
2652 prcD.bndType := rec;
2653 IF nextT.sym = T.lbrackSym THEN
2654 IF ~Cs.special THEN SemError(144) END;
2655 Get;
2656 Expect(T.stringSym);
2657 name := LitValue.subStrToCharOpen(token.pos+1, token.len-2);
2658 prcD.prcNm := name;
2659 Expect(T.rbrackSym);
2660 IF Cs.verbose THEN Cs.Message('external procName "' + name^ + '"') END;
2661 END;
2662 prcT := Ty.newPrcTp();
2663 prcT.idnt := prcD;
2664 IF prcD.vMod # Sy.prvMode THEN INCL(prcD.pAttr, Id.public) END;
2665 IF nextT.sym = T.lparenSym THEN
2666 FormalParameters(prcT, prcD, scp);
2667 END;
2668 prcD.type := prcT;
2669 Ty.InsertInRec(prcD,rec,FALSE,oId,ok);
2670 IF ok THEN
2671 Sy.AppendIdnt(rec.statics, prcD);
2672 (*
2673 * Put this header on the procedure list,
2674 * so that it gets various semantic checks.
2675 *)
2676 Id.AppendProc(Cs.thisMod.procs, prcD);
2677 ELSE
2678 prcD.IdError(6);
2679 END;
2680 END StaticProc;
2681 (* ----------------------------------------- *)
2682 PROCEDURE StaticConst(lst : Sy.IdSeq;
2683 rec : Ty.Record;
2684 scp : Sy.Scope);
2685 VAR vrId : Sy.Idnt;
2686 cnId : Id.ConId;
2687 cnEx : Sy.Expr;
2688 oId : Id.OvlId;
2689 ok : BOOLEAN;
2690 BEGIN
2691 Expect(T.equalSym);
2692 (*
2693 * We have a list of VarId here. If the list
2694 * has more than one element, then that is an
2695 * error, otherwise copy info to a ConId ...
2696 *)
2697 IF lst.tide > 1 THEN lst.a[1].IdError(192); RETURN END;
2698 vrId := lst.a[0];
2699 cnId := Id.newConId();
2700 cnId.token := vrId.token;
2701 cnId.hash := vrId.hash;
2702 cnId.dfScp := vrId.dfScp;
2703 cnId.SetMode(vrId.vMod);
2704 cnEx := constExpression(scp);
2705 cnId.conExp := cnEx;
2706 cnId.type := cnEx.type;
2707 Ty.InsertInRec(cnId,rec,FALSE,oId,ok);
2708 IF ok THEN
2709 Sy.AppendIdnt(rec.statics, cnId);
2710 ELSE
2711 cnId.IdError(6);
2712 END;
2713 END StaticConst;
2714 (* ----------------------------------------- *)
2715 PROCEDURE StaticField(lst : Sy.IdSeq;
2716 rec : Ty.Record;
2717 scp : Sy.Scope);
2718 VAR flTp : Sy.Type;
2719 flId : Id.VarId;
2720 indx : INTEGER;
2721 oId : Id.OvlId;
2722 ok : BOOLEAN;
2723 BEGIN
2724 Get; (* read past colon *)
2725 flTp := type(scp, Sy.pubMode);
2726 FOR indx := 0 TO lst.tide-1 DO
2727 flId := lst.a[indx](Id.VarId);
2728 flId.type := flTp;
2729 flId.recTyp := rec;
2730 Ty.InsertInRec(flId,rec,FALSE,oId,ok);
2731 IF ok THEN
2732 Sy.AppendIdnt(rec.statics, flId);
2733 ELSE
2734 flId.IdError(6);
2735 END;
2736 END;
2737 END StaticField;
2738 (* ----------------------------------------- *)
2739 PROCEDURE DoStatic(rec : Ty.Record;
2740 scp : Sy.Scope);
2741 (*
2742 * StatDef --> PROCEDURE ProcHeading
2743 * | IdentDef { ',' IdentDef } ":" Type
2744 * | IdentDef "=" Constant .
2745 *)
2746 VAR list : Sy.IdSeq;
2747 BEGIN
2748 IF nextT.sym = T.PROCEDURESym THEN
2749 StaticProc(rec, scp);
2750 ELSIF nextT.sym = T.identSym THEN
2751 (*
2752 * There is a syntactic ambiguity here.
2753 * after an abitrary lookahead we find
2754 * the symbol which determines if this
2755 * is a constant or a variable definition.
2756 * We will "predict" a variable and then
2757 * back-patch later, if necessary.
2758 *)
2759 IdentDefList(list, scp, Id.varId);
2760 IF nextT.sym = T.colonSym THEN
2761 StaticField(list, rec, scp);
2762 ELSIF nextT.sym = T.equalSym THEN
2763 StaticConst(list, rec, scp);
2764 ELSE
2765 SemError(192); Get;
2766 END;
2767 ELSE (* skip redundant semicolons *)
2768 END;
2769 END DoStatic;
2770 (* ----------------------------------------- *)
2771 BEGIN
2772 DoStatic(recT, defScp);
2773 WHILE (nextT.sym = T.semicolonSym) DO
2774 Get;
2775 DoStatic(recT, defScp);
2776 END;
2777 END StaticStuff;
2778
2779 (* ==================================================================== *)
2780
2781 PROCEDURE EnumConst(enum : Ty.Enum;
2782 defScp : Sy.Scope;
2783 vMod : INTEGER); (* vMod ??? *)
2784 VAR idnt : Sy.Idnt;
2785 cnId : Id.ConId;
2786 cnEx : Sy.Expr;
2787 BEGIN
2788 IF nextT.sym # T.identSym THEN RETURN END; (* skip extra semis! *)
2789 idnt := identDef(defScp, Id.conId);
2790 cnId := idnt(Id.ConId); (* don't insert yet! *)
2791 Expect(T.equalSym);
2792 cnEx := constExpression(defScp);
2793 cnId.conExp := cnEx;
2794 cnId.type := cnEx.type;
2795 IF cnId.type # Bi.intTp THEN cnEx.ExprError(37) END;
2796 IF enum.symTb.enter(cnId.hash, cnId) THEN
2797 Sy.AppendIdnt(enum.statics, cnId);
2798 ELSE
2799 cnId.IdError(6);
2800 END;
2801 END EnumConst;
2802
2803 (* ==================================================================== *)
2804
2805 PROCEDURE ArrLength(defScp : Sy.Scope; OUT n : INTEGER; OUT p : BOOLEAN);
2806 VAR xSyn : Xp.LeafX;
2807 BEGIN
2808 n := 0;
2809 p := FALSE;
2810 xSyn := constExpression(defScp);
2811 IF xSyn # NIL THEN
2812 IF xSyn.kind = Xp.numLt THEN
2813 n := xSyn.value.int();
2814 IF n > 0 THEN p := TRUE ELSE SemError(68) END;
2815 ELSE
2816 SemError(31);
2817 END;
2818 END;
2819 END ArrLength;
2820
2821 (* ==================================================================== *)
2822
2823 PROCEDURE PointerType(pTyp : Ty.Pointer; defScp : Sy.Scope; vMod : INTEGER);
2824 BEGIN
2825 Expect(T.POINTERSym);
2826 Expect(T.TOSym);
2827 pTyp.boundTp := type(defScp, vMod);
2828 END PointerType;
2829
2830 (* ==================================================================== *)
2831
2832 PROCEDURE EventType(eTyp : Ty.Procedure; defScp : Sy.Scope; vMod : INTEGER);
2833 BEGIN
2834 Expect(T.EVENTSym);
2835 IF ~Cs.targetIsNET() THEN SemError(208);
2836 ELSIF Cs.strict THEN SemError(221);
2837 END;
2838 IF ~(defScp IS Id.BlkId) THEN SemError(212) END;
2839 IF (nextT.sym = T.lparenSym) THEN
2840 FormalParameters(eTyp, NIL, defScp);
2841 ELSE SemError(209);
2842 END;
2843 END EventType;
2844
2845 (* ==================================================================== *)
2846
2847 PROCEDURE RecordType(rTyp : Ty.Record; defScp : Sy.Scope; vMod : INTEGER);
2848 (*
2849 * Record --> RECORD ['(' tpQual { '+' tpQual } ')']
2850 * FieldListSequence
2851 * [ STATIC StatDef { ';' StatDef } ] END .
2852 *)
2853 VAR tpId : Id.TypId;
2854 BEGIN
2855 Expect(T.RECORDSym);
2856 IF Sy.frnMd IN Cs.thisMod.xAttr THEN
2857 INCL(rTyp.xAttr, Sy.isFn); (* must be foreign *)
2858 END;
2859 IF (nextT.sym = T.lparenSym) THEN
2860 Get;
2861 IF nextT.sym # T.plusSym THEN
2862 tpId := typeQualid(defScp);
2863 ELSE
2864 tpId := Bi.anyTpId;
2865 END;
2866 IF tpId # NIL THEN rTyp.baseTp := tpId.type END;
2867 INCL(rTyp.xAttr, Sy.clsTp); (* must be a class *)
2868 (* interfaces ... *)
2869 WHILE (nextT.sym = T.plusSym) DO
2870 Get;
2871 IF Cs.strict & (nextT.sym = T.plusSym) THEN SemError(221); END;
2872 tpId := typeQualid(defScp);
2873 IF tpId # NIL THEN Sy.AppendType(rTyp.interfaces, tpId.type) END;
2874 END;
2875 Expect(T.rparenSym);
2876 END;
2877 FieldListSequence(rTyp, defScp, vMod);
2878 IF nextT.sym = T.STATICSym THEN
2879 Get;
2880 IF ~Cs.special THEN SemError(185) END;
2881 INCL(rTyp.xAttr, Sy.isFn); (* must be foreign *)
2882 StaticStuff(rTyp, defScp, vMod);
2883 END;
2884 Expect(T.ENDSym);
2885 END RecordType;
2886
2887 (* ==================================================================== *)
2888
2889 PROCEDURE EnumType(enum : Ty.Enum; defScp : Sy.Scope; vMod : INTEGER);
2890 (*
2891 * Enum --> ENUM RECORD StatDef { ';' StatDef } END .
2892 *)
2893 BEGIN
2894 IF ~Cs.special THEN SemError(185) END;
2895 Get; (* read past ENUM *)
2896 (* Expect(T.RECORDSym); *)
2897 EnumConst(enum, defScp, vMod);
2898 WHILE (nextT.sym = T.semicolonSym) DO
2899 Get;
2900 EnumConst(enum, defScp, vMod);
2901 END;
2902 Expect(T.ENDSym);
2903 END EnumType;
2904
2905 (* ==================================================================== *)
2906
2907 PROCEDURE OptAttr (rTyp : Ty.Record);
2908 BEGIN
2909 INCL(rTyp.xAttr, Sy.clsTp); (* must be a class *)
2910 IF nextT.sym = T.ABSTRACTSym THEN
2911 Get;
2912 rTyp.recAtt := Ty.isAbs;
2913 ELSIF nextT.sym = T.EXTENSIBLESym THEN
2914 Get;
2915 rTyp.recAtt := Ty.extns;
2916 ELSIF nextT.sym = T.LIMITEDSym THEN
2917 Get;
2918 rTyp.recAtt := Ty.limit;
2919 ELSIF nextT.sym = T.INTERFACESym THEN
2920 Get;
2921 IF Cs.strict THEN SemError(221); END;
2922 rTyp.recAtt := Ty.iFace;
2923 ELSE Error(87);
2924 END;
2925 END OptAttr;
2926
2927 (* ==================================================================== *)
2928
2929 PROCEDURE ArrayType (aTyp : Ty.Array; defScp : Sy.Scope; vMod : INTEGER);
2930 VAR length : INTEGER;
2931 ok : BOOLEAN;
2932 elemT : Ty.Array;
2933 BEGIN
2934 Expect(T.ARRAYSym);
2935 IF in(symSet[3], nextT.sym) THEN
2936 ArrLength(defScp, length, ok);
2937 IF ok THEN aTyp.length := length END;
2938 WHILE (nextT.sym = T.commaSym) DO
2939 Get;
2940 ArrLength(defScp, length, ok);
2941 elemT := Ty.newArrTp(); aTyp.elemTp := elemT; aTyp := elemT;
2942 IF ok THEN aTyp.length := length END;
2943 END;
2944 END;
2945 Expect(T.OFSym);
2946 aTyp.elemTp := type(defScp, vMod);
2947
2948 IF vMod # Sy.prvMode THEN FixAnon(defScp, aTyp.elemTp, vMod) END;
2949 END ArrayType;
2950
2951 (* ==================================================================== *)
2952
2953 PROCEDURE VectorType (aTyp : Ty.Vector; defScp : Sy.Scope; vMod : INTEGER);
2954 VAR length : INTEGER;
2955 ok : BOOLEAN;
2956 elemT : Ty.Array;
2957 BEGIN
2958 Expect(T.VECTORSym);
2959 Expect(T.OFSym);
2960 aTyp.elemTp := type(defScp, vMod);
2961 IF vMod # Sy.prvMode THEN FixAnon(defScp, aTyp.elemTp, vMod) END;
2962 IF Cs.strict THEN SemError(221) END;
2963 END VectorType;
2964
2965 (* ==================================================================== *)
2966
2967 PROCEDURE ProcedureType(pTyp : Ty.Procedure; defScp : Sy.Scope);
2968 BEGIN
2969 Expect(T.PROCEDURESym);
2970 IF (nextT.sym = T.lparenSym) THEN
2971 FormalParameters(pTyp, NIL, defScp);
2972 ELSIF (nextT.sym = T.rparenSym) OR
2973 (nextT.sym = T.ENDSym) OR
2974 (nextT.sym = T.semicolonSym) THEN
2975 (* skip *)
2976 ELSE Error(88);
2977 END;
2978 END ProcedureType;
2979
2980 (* ==================================================================== *)
2981
2982 PROCEDURE CompoundType(defScp : Sy.Scope; firstType : Id.TypId) : Sy.Type;
2983 (* Parses a compound type from a series of comma separated qualidents.
2984 * One component of the compound type has already been parsed and is
2985 * passed as firstType. The next token is a comma. At most one of the
2986 * types can be a class, and all the others must be interfaces. The
2987 * type that is returned is a Pointer to a Record with the compound
2988 * type flag set. *)
2989 (* Things that could be checked here but aren't yet:
2990 * - that any interfaces are not part of the base type
2991 - that any interfaces are not entered more than once
2992 *)
2993 VAR
2994 ptrT : Ty.Pointer;
2995 cmpT : Ty.Record;
2996 tpId : Id.TypId;
2997
2998 (* Checks to make sure the type is suitable for use in a compound
2999 * type *)
3000 PROCEDURE checkType(type : Sy.Type) : BOOLEAN;
3001 BEGIN
3002 IF (type = NIL) OR
3003 ~(type.isRecordType() OR type.isDynamicType()) THEN
3004 Error(89);
3005 RETURN FALSE;
3006 ELSE
3007 RETURN TRUE;
3008 END;
3009 END checkType;
3010
3011 BEGIN
3012 (* Check that we were passed an appropriate type and that
3013 * a comma is following *)
3014 IF ~checkType(firstType.type) THEN Error(89); RETURN NIL END;
3015 IF nextT.sym # T.commaSym THEN Error(12); RETURN NIL END;
3016
3017 (* Create the compound type *)
3018 cmpT := Ty.newRecTp();
3019 cmpT.recAtt := Ty.cmpnd;
3020
3021 IF firstType.type.isInterfaceType() THEN
3022 (* Add it to the list of interfaces *)
3023 Sy.AppendType(cmpT.interfaces, firstType.type);
3024 ELSE
3025 (* Make it our base type *)
3026 cmpT.baseTp := firstType.type;
3027 END;
3028
3029 WHILE nextT.sym = T.commaSym DO
3030 Get; (* Eat the comma *)
3031 IF nextT.sym # T.identSym THEN Error(T.identSym) END;
3032 tpId := typeQualid(defScp);
3033 IF ~checkType(tpId.type) THEN RETURN NIL END;
3034 IF tpId.type.isInterfaceType() THEN
3035 Sy.AppendType(cmpT.interfaces, tpId.type);
3036 ELSE
3037 IF cmpT.baseTp # NIL THEN Error(89); RETURN NIL END;
3038 cmpT.baseTp := tpId.type;
3039 END;
3040 END;
3041 INCL(cmpT.xAttr, Sy.clsTp); (* must be a class *)
3042 ptrT := Ty.newPtrTp();
3043 ptrT.boundTp := cmpT;
3044 RETURN ptrT;
3045 END CompoundType;
3046
3047 (* ==================================================================== *)
3048
3049 PROCEDURE type(defScp : Sy.Scope; vMod : INTEGER) : Sy.Type;
3050 VAR tpId : Id.TypId;
3051 prcT : Ty.Procedure;
3052 recT : Ty.Record;
3053 arrT : Ty.Array;
3054 vecT : Ty.Vector;
3055 ptrT : Ty.Pointer;
3056 enuT : Ty.Enum;
3057 BEGIN
3058 IF (nextT.sym = T.identSym) THEN
3059 tpId := typeQualid(defScp);
3060 IF tpId = NIL THEN RETURN NIL END;
3061 IF ~Cs.extras THEN RETURN tpId.type END;
3062 (* Compound type parsing... look for comma *)
3063 IF nextT.sym # T.commaSym THEN RETURN tpId.type
3064 ELSE RETURN CompoundType(defScp, tpId) END;
3065 ELSIF (nextT.sym = T.PROCEDURESym) THEN
3066 prcT := Ty.newPrcTp();
3067 ProcedureType(prcT, defScp); RETURN prcT;
3068 ELSIF (nextT.sym = T.ARRAYSym) THEN
3069 arrT := Ty.newArrTp();
3070 ArrayType(arrT, defScp, vMod); RETURN arrT;
3071 ELSIF (nextT.sym = T.VECTORSym) THEN
3072 vecT := Ty.newVecTp();
3073 VectorType(vecT, defScp, vMod); RETURN vecT;
3074 ELSIF (nextT.sym = T.ABSTRACTSym) OR
3075 (nextT.sym = T.EXTENSIBLESym) OR
3076 (nextT.sym = T.LIMITEDSym) OR
3077 (nextT.sym = T.INTERFACESym) OR
3078 (nextT.sym = T.RECORDSym) THEN
3079 recT := Ty.newRecTp();
3080 IF nextT.sym # T.RECORDSym THEN OptAttr(recT) END;
3081 RecordType(recT, defScp, vMod); RETURN recT;
3082 ELSIF (nextT.sym = T.POINTERSym) THEN
3083 ptrT := Ty.newPtrTp();
3084 PointerType(ptrT, defScp, vMod); RETURN ptrT;
3085 ELSIF (nextT.sym = T.ENUMSym) THEN
3086 enuT := Ty.newEnuTp();
3087 EnumType(enuT, defScp, vMod); RETURN enuT;
3088 ELSIF (nextT.sym = T.EVENTSym) THEN
3089 prcT := Ty.newEvtTp();
3090 EventType(prcT, defScp, vMod); RETURN prcT;
3091 ELSE
3092 Error(89); RETURN NIL;
3093 END;
3094 END type;
3095
3096 (* ==================================================================== *)
3097
3098 PROCEDURE TypeDeclaration(defScp : Sy.Scope);
3099 VAR iTmp : Sy.Idnt;
3100 stuck : BOOLEAN;
3101 BEGIN
3102 iTmp := identDef(defScp, Id.typId);
3103 IF iTmp.vMod = Sy.rdoMode THEN SemError(134) END;
3104 Expect(T.equalSym);
3105 iTmp.type := type(defScp, iTmp.vMod);
3106 IF (iTmp.type # NIL) & iTmp.type.isAnonType() THEN
3107 iTmp.type.idnt := iTmp;
3108 END;
3109 stuck := Sy.refused(iTmp, defScp);
3110 IF stuck THEN iTmp.IdError(4) END;
3111 END TypeDeclaration;
3112
3113 (* ==================================================================== *)
3114
3115 PROCEDURE expression(scope : Sy.Scope) : Sy.Expr;
3116 VAR relOp : INTEGER;
3117 expN1 : Sy.Expr;
3118 expN2 : Sy.Expr;
3119 saveT : S.Token;
3120 tokN1 : S.Token;
3121 (* ------------------------------------------ *)
3122 PROCEDURE MarkAssign(id : Sy.Idnt);
3123 BEGIN
3124 IF (id # NIL) & (id IS Id.Procs) THEN
3125 INCL(id(Id.Procs).pAttr, Id.assgnd);
3126 END;
3127 END MarkAssign;
3128 (* ------------------------------------------ *)
3129 BEGIN
3130 tokN1 := nextT;
3131 expN1 := simpleExpression(scope);
3132 (*
3133 * Mark use of procedure-valued expressions.
3134 *)
3135 WITH expN1 : Xp.IdLeaf DO
3136 MarkAssign(expN1.ident);
3137 | expN1 : Xp.IdentX DO
3138 MarkAssign(expN1.ident);
3139 ELSE
3140 END;
3141 (*
3142 * ... and parse the substructures!
3143 *)
3144 IF in(symSet[12], nextT.sym) THEN
3145 relOp := relation(); saveT := token;
3146 expN2 := simpleExpression(scope);
3147 expN1 := Xp.newBinaryT(relOp, expN1, expN2, saveT);
3148 END;
3149 IF expN1 # NIL THEN expN1.tSpan := S.mkSpanTT(tokN1, S.prevTok) END;
3150 RETURN expN1;
3151 END expression;
3152
3153 (* ==================================================================== *)
3154
3155 PROCEDURE constExpression(defScp : Sy.Scope) : Xp.LeafX;
3156 VAR expr : Sy.Expr;
3157 orig : S.Span;
3158 (* ------------------------------------------ *)
3159 PROCEDURE eval(exp : Sy.Expr) : Sy.Expr;
3160 BEGIN
3161 RETURN exp.exprAttr();
3162 RESCUE (junk)
3163 exp.ExprError(55);
3164 RETURN NIL;
3165 END eval;
3166 (* ------------------------------------------ *)
3167 BEGIN
3168 expr := expression(defScp);
3169 IF expr # NIL THEN
3170 orig := expr.tSpan;
3171 expr := eval(expr);
3172 IF expr = NIL THEN (* skip *)
3173 ELSIF (expr IS Xp.LeafX) &
3174 (expr.kind # Xp.setXp) THEN
3175 expr.tSpan := orig;
3176 RETURN expr(Xp.LeafX);
3177 ELSE
3178 expr.ExprError(25); (* expr not constant *)
3179 END;
3180 END;
3181 RETURN NIL;
3182 END constExpression;
3183
3184 (* ==================================================================== *)
3185
3186 PROCEDURE ConstantDeclaration (defScp : Sy.Scope);
3187 VAR idnt : Sy.Idnt;
3188 cnId : Id.ConId;
3189 cnEx : Xp.LeafX;
3190 BEGIN
3191 idnt := identDef(defScp, Id.conId);
3192 cnId := idnt(Id.ConId); (* don't insert yet! *)
3193 Expect(T.equalSym);
3194 cnEx := constExpression(defScp);
3195 IF Sy.refused(idnt, defScp) THEN idnt.IdError(4) END;
3196 IF (cnId # NIL) & (cnEx # NIL) THEN
3197 cnId.conExp := cnEx;
3198 cnId.type := cnEx.type;
3199 END;
3200 END ConstantDeclaration;
3201
3202 (* ==================================================================== *)
3203
3204 PROCEDURE qualident(defScp : Sy.Scope) : Sy.Idnt;
3205 (* Postcondition: returns a valid Id, or NIL. *
3206 * NIL ==> error already notified. *)
3207 VAR idnt : Sy.Idnt;
3208 locl : Id.LocId;
3209 tpId : Id.TypId;
3210 tpTp : Sy.Type;
3211 (* modS : Sy.Scope; *)
3212 modS : Id.BlkId;
3213 hash : INTEGER;
3214 eNum : INTEGER;
3215 BEGIN
3216 Expect(T.identSym);
3217 hash := NameHash.enterSubStr(token.pos, token.len);
3218 idnt := Sy.bind(hash, defScp);
3219 IF idnt = NIL THEN
3220 SemError(2); RETURN NIL;
3221 ELSIF (idnt.kind # Id.impId) & (idnt.kind # Id.alias) THEN
3222 (*
3223 * This is a single token qualident.
3224 * Now we check for uplevel addressing.
3225 * Temporarily disallowed in boot version 0.n and 1.0
3226 *)
3227 IF (idnt.dfScp # NIL) & (* There is a scope, *)
3228 (idnt.dfScp # defScp) & (* not current scope, *)
3229 (idnt IS Id.AbVar) & (* is a variable, and *)
3230 (idnt.dfScp IS Id.Procs) THEN (* scope is a PROC. *)
3231 SemError(302);
3232 locl := idnt(Id.LocId);
3233 IF ~(Id.uplevA IN locl.locAtt) THEN
3234 eNum := 311;
3235 WITH locl : Id.ParId DO
3236 IF (locl.parMod # Sy.val) &
3237 (locl.type # NIL) &
3238 ~Cs.targetIsJVM() &
3239 ~locl.type.isRefSurrogate() THEN
3240 eNum := 310;
3241 INCL(locl.locAtt, Id.cpVarP);
3242 END;
3243 ELSE (* skip *)
3244 END;
3245 locl.IdErrorStr(eNum, Sy.getName.ChPtr(idnt));
3246 INCL(idnt.dfScp(Id.Procs).pAttr, Id.hasXHR);
3247 INCL(locl.locAtt, Id.uplevA); (* uplevel Any *)
3248 END;
3249 END;
3250 RETURN idnt;
3251 ELSE
3252 modS := idnt(Id.BlkId);
3253 IF Sy.anon IN modS.xAttr THEN
3254 SemErrorS1(239, Sy.getName.ChPtr(modS.aliasMod));
3255 END;
3256 END;
3257 Expect(T.pointSym);
3258 Expect(T.identSym);
3259 (*
3260 * At this point the only live control flow branch is
3261 * the one predicated on the ident being a scope name.
3262 *)
3263 idnt := bindTokenLocal(modS);
3264 IF idnt = NIL THEN
3265 SemError(3); (* name not known in qualified scope *)
3266 ELSIF modS.isWeak() THEN
3267 SemErrorS1(175, Sy.getName.ChPtr(modS)); (* mod not directly imported *)
3268 ELSE
3269 RETURN idnt;
3270 END;
3271 RETURN NIL;
3272 END qualident;
3273
3274 (* ==================================================================== *)
3275
3276 PROCEDURE typeQualid(defScp : Sy.Scope) : Id.TypId;
3277 (** This procedure returns one of --
3278 a valid Id.TypId (possibly a forward type)
3279 NIL (with an error already notified) *)
3280 VAR idnt : Sy.Idnt;
3281 tpId : Id.TypId;
3282 tpTp : Sy.Type;
3283 modS : Id.BlkId;
3284 hash : INTEGER;
3285 BEGIN
3286 Expect(T.identSym);
3287 hash := NameHash.enterSubStr(token.pos, token.len);
3288 idnt := Sy.bind(hash, defScp);
3289 modS := NIL;
3290 IF idnt = NIL THEN
3291 (*
3292 * This _might_ just be a forward type. It cannot be so
3293 * if the next token is "." or if declarations in this
3294 * scope are officially closed.
3295 *)
3296 IF (nextT.sym = T.pointSym) OR defScp.endDecl THEN
3297 SemError(2);
3298 IF nextT.sym # T.pointSym THEN RETURN NIL END;
3299 ELSE
3300 tpTp := Ty.newTmpTp();
3301 tpId := Id.newTypId(tpTp);
3302 tpId.dfScp := defScp;
3303 tpId.token := token;
3304 tpId.hash := hash;
3305 tpTp.idnt := tpId;
3306 RETURN tpId;
3307 END;
3308 ELSIF idnt.kind = Id.typId THEN
3309 RETURN idnt(Id.TypId);
3310 ELSIF (idnt.kind = Id.impId) OR (idnt.kind = Id.alias) THEN
3311 modS := idnt(Id.BlkId);
3312 IF Sy.anon IN modS.xAttr THEN
3313 SemErrorS1(239, Sy.getName.ChPtr(modS.aliasMod));
3314 END;
3315 ELSE
3316 SemError(5);
3317 IF nextT.sym # T.pointSym THEN RETURN NIL END;
3318 END;
3319 Expect(T.pointSym);
3320 Expect(T.identSym);
3321 IF modS = NIL THEN RETURN NIL END;
3322 (*
3323 * At this point the only live control flow branch is
3324 * the one predicated on the ident being a scope name.
3325 *)
3326 idnt := bindTokenLocal(modS);
3327 IF idnt = NIL THEN
3328 SemError(3); (* name not known in qualified scope *)
3329 ELSIF modS.isWeak() THEN
3330 SemErrorS1(175, Sy.getName.ChPtr(modS)); (* mod not directly imported *)
3331 ELSIF idnt.kind # Id.typId THEN
3332 SemError(7); (* name is not the name of a type *)
3333 ELSE
3334 tpId := idnt(Id.TypId);
3335 RETURN tpId;
3336 END;
3337 RETURN NIL;
3338 END typeQualid;
3339
3340 (* ==================================================================== *)
3341
3342 PROCEDURE identDef(inhScp : Sy.Scope; tag : INTEGER) : Sy.Idnt;
3343 (** This non-terminal symbol creates an Id of prescribed kind for
3344 the ident. The Id has its parent scope assigned, but is not yet
3345 inserted into the prescribed scope. *)
3346 VAR iSyn : Sy.Idnt;
3347 BEGIN
3348 CASE tag OF
3349 | Id.conId : iSyn := Id.newConId();
3350 | Id.parId : iSyn := Id.newParId();
3351 | Id.quaId : iSyn := Id.newQuaId();
3352 | Id.modId : iSyn := Id.newModId();
3353 | Id.impId : iSyn := Id.newImpId();
3354 | Id.fldId : iSyn := Id.newFldId();
3355 | Id.fwdMth : iSyn := Id.newMthId();
3356 | Id.conMth : iSyn := Id.newMthId();
3357 | Id.fwdPrc : iSyn := Id.newPrcId();
3358 | Id.conPrc : iSyn := Id.newPrcId();
3359 | Id.typId : iSyn := Id.newTypId(NIL);
3360 | Id.fwdTyp : iSyn := Id.newTypId(NIL);
3361 | Id.varId : IF inhScp IS Id.BlkId THEN
3362 iSyn := Id.newVarId();
3363 ELSE
3364 iSyn := Id.newLocId();
3365 END;
3366 END;
3367 IF iSyn IS Sy.Scope THEN iSyn(Sy.Scope).ovfChk := Cs.ovfCheck END;
3368 iSyn.token := nextT;
3369 iSyn.hash := NameHash.enterSubStr(nextT.pos, nextT.len);
3370 IF Cs.verbose THEN iSyn.SetNameFromHash(iSyn.hash) END;
3371 iSyn.dfScp := inhScp;
3372 IF nextT.dlr & ~Cs.special THEN SemErrorT(186, nextT) END;
3373 Expect(T.identSym);
3374 IF (nextT.sym = T.starSym) OR
3375 (nextT.sym = T.bangSym) OR
3376 (nextT.sym = T.minusSym) THEN
3377 IF (nextT.sym = T.starSym) THEN
3378 Get;
3379 iSyn.SetMode(Sy.pubMode);
3380 ELSIF (nextT.sym = T.minusSym) THEN
3381 Get;
3382 iSyn.SetMode(Sy.rdoMode);
3383 ELSE
3384 Get;
3385 iSyn.SetMode(Sy.protect);
3386 IF ~Cs.special THEN SemError(161) END;
3387 END;
3388 END;
3389 IF (iSyn.vMod # Sy.prvMode) & (inhScp # Cs.thisMod) THEN
3390 SemError(128);
3391 END;
3392 RETURN iSyn;
3393 END identDef;
3394
3395 (* ==================================================================== *)
3396
3397 PROCEDURE Module;
3398 VAR err : INTEGER;
3399 nam : FileNames.NameString;
3400 hsh : INTEGER;
3401 tok : S.Token;
3402 BEGIN
3403 IF nextT.sym = T.identSym THEN
3404 hsh := NameHash.enterSubStr(nextT.pos, nextT.len);
3405 IF hsh = Bi.sysBkt THEN
3406 Get;
3407 INCL(Cs.thisMod.xAttr, Sy.rtsMd);
3408 IF Cs.verbose THEN Cs.Message("Compiling a SYSTEM Module") END;
3409 IF ~Cs.special THEN SemError(144) END;
3410 ELSIF hsh = Bi.frnBkt THEN
3411 Get;
3412 INCL(Cs.thisMod.xAttr, Sy.frnMd);
3413 IF Cs.verbose THEN Cs.Message("Compiling a FOREIGN Module") END;
3414 IF ~Cs.special THEN SemError(144) END;
3415 END;
3416 ForeignMod;
3417 ELSIF nextT.sym = T.MODULESym THEN
3418 (* Except for empty bodies this next will be overwritten later *)
3419 Cs.thisMod.begTok := nextT;
3420 CPmodule;
3421 END;
3422 Cs.thisMod.endTok := nextT;
3423 Expect(T.ENDSym);
3424 Expect(T.identSym);
3425 S.GetString(token.pos, token.len, nam);
3426 IF nam # Cs.modNam THEN
3427 IF token.sym = T.identSym THEN err := 1 ELSE err := 0 END;
3428 SemErrorS1(err, Cs.modNam$);
3429 END;
3430 Expect(T.pointSym);
3431 END Module;
3432
3433 (* ==================================================================== *)
3434
3435 PROCEDURE Parse*;
3436 BEGIN
3437 NEW(nextT); (* so that token is not even NIL initially *)
3438 S.Reset; Get;
3439 Cs.parseS := RTS.GetMillis();
3440 Module;
3441 END Parse;
3442
3443 (* ==================================================================== *)
3444
3445 PROCEDURE parseTextAsStatement*(text : ARRAY OF LitValue.CharOpen; encScp : Sy.Scope) : Sy.Stmt;
3446 VAR result : Sy.Stmt;
3447 BEGIN
3448 Cs.SetQuiet;
3449 NEW(nextT);
3450 S.NewReadBuffer(text); Get;
3451 result := statementSequence(NIL, encScp);
3452 S.RestoreFileBuffer();
3453 Cs.RestoreQuiet;
3454 RETURN result;
3455 END parseTextAsStatement;
3456
3457 PROCEDURE ParseDeclarationText*(text : ARRAY OF LitValue.CharOpen; encScp : Sy.Scope);
3458 BEGIN
3459 Cs.SetQuiet;
3460 NEW(nextT);
3461 S.NewReadBuffer(text); Get;
3462 DeclarationSequence(encScp);
3463 S.RestoreFileBuffer();
3464 Cs.RestoreQuiet;
3465 END ParseDeclarationText;
3466
3467 (* ==================================================================== *)
3468
3469 BEGIN
3470 comma := LitValue.strToCharOpen(",");
3471 errDist := minErrDist;
3472 (* ------------------------------------------------------------ *)
3473
3474 symSet[ 0, 0] := {T.EOFSYM, T.identSym, T.ENDSym, T.semicolonSym};
3475 symSet[ 0, 1] := {T.EXITSym-32, T.RETURNSym-32, T.NEWSym-32, T.IFSym-32,
3476 T.ELSIFSym-32, T.ELSESym-32, T.CASESym-32, T.barSym-32,
3477 T.WHILESym-32, T.REPEATSym-32, T.UNTILSym-32, T.FORSym-32};
3478 symSet[ 0, 2] := {T.LOOPSym-64, T.WITHSym-64, T.CLOSESym-64};
3479 (* ------------------------------------------------------------ *)
3480
3481 (* Follow comma in ident-list *)
3482 symSet[ 1, 0] := {T.identSym};
3483 symSet[ 1, 1] := {};
3484 symSet[ 1, 2] := {};
3485 (* ------------------------------------------------------------ *)
3486
3487 (* Follow(ident-list) *)
3488 symSet[ 2, 0] := {T.colonSym};
3489 symSet[ 2, 1] := {};
3490 symSet[ 2, 2] := {};
3491 (* ------------------------------------------------------------ *)
3492
3493 (* Start(expression) *)
3494 symSet[ 3, 0] := {T.identSym, T.integerSym, T.realSym, T.CharConstantSym,
3495 T.stringSym, T.minusSym, T.lparenSym, T.plusSym};
3496 symSet[ 3, 1] := {T.NILSym-32, T.tildeSym-32, T.lbraceSym-32};
3497 symSet[ 3, 2] := {T.bangStrSym-64};
3498 (* ------------------------------------------------------------ *)
3499
3500 (* lookahead of optional statement *)
3501 symSet[ 4, 0] := {T.EOFSYM, T.identSym, T.ENDSym, T.semicolonSym};
3502 symSet[ 4, 1] := {T.EXITSym-32, T.RETURNSym-32, T.NEWSym-32, T.IFSym-32,
3503 T.ELSIFSym-32, T.ELSESym-32, T.CASESym-32, T.barSym-32,
3504 T.WHILESym-32, T.REPEATSym-32, T.UNTILSym-32, T.FORSym-32};
3505 symSet[ 4, 2] := {T.LOOPSym-64, T.WITHSym-64, T.CLOSESym-64, T.RESCUESym-64};
3506 (* ------------------------------------------------------------ *)
3507
3508 (* follow semicolon in statementSequence *)
3509 symSet[ 5, 0] := {T.identSym, T.ENDSym, T.semicolonSym};
3510 symSet[ 5, 1] := {T.EXITSym-32, T.RETURNSym-32, T.NEWSym-32, T.IFSym-32,
3511 T.ELSIFSym-32, T.ELSESym-32, T.CASESym-32, T.barSym-32,
3512 T.WHILESym-32, T.REPEATSym-32, T.UNTILSym-32, T.FORSym-32};
3513 symSet[ 5, 2] := {T.LOOPSym-64, T.WITHSym-64, T.CLOSESym-64, T.RESCUESym-64};
3514 (* ------------------------------------------------------------ *)
3515
3516 (* Follow(statementSequence) *)
3517 symSet[ 6, 0] := {T.ENDSym};
3518 symSet[ 6, 1] := {T.ELSIFSym-32, T.ELSESym-32, T.barSym-32, T.UNTILSym-32};
3519 symSet[ 6, 2] := {T.CLOSESym-64, T.RESCUESym-64};
3520 (* ------------------------------------------------------------ *)
3521
3522 (* Follow(barSym) *)
3523 symSet[ 7, 0] := {T.EOFSYM, T.identSym, T.integerSym, T.realSym,
3524 T.CharConstantSym, T.stringSym, T.minusSym, T.lparenSym,
3525 T.plusSym, T.ENDSym, T.semicolonSym};
3526 symSet[ 7, 1] := {T.NILSym-32, T.tildeSym-32, T.lbraceSym-32,
3527 T.EXITSym-32, T.RETURNSym-32, T.NEWSym-32, T.IFSym-32,
3528 T.ELSIFSym-32, T.ELSESym-32, T.CASESym-32, T.barSym-32,
3529 T.WHILESym-32, T.REPEATSym-32, T.UNTILSym-32, T.FORSym-32};
3530 symSet[ 7, 2] := {T.LOOPSym-64, T.WITHSym-64, T.CLOSESym-64};
3531 (* ------------------------------------------------------------ *)
3532
3533 (* lookahead to optional arglist *)
3534 symSet[ 8, 0] := {(*T.lparenSym,*) T.ENDSym, T.semicolonSym};
3535 symSet[ 8, 1] := {T.ELSIFSym-32, T.ELSESym-32, T.barSym-32, T.UNTILSym-32};
3536 symSet[ 8, 2] := {T.CLOSESym-64};
3537 (* ------------------------------------------------------------ *)
3538
3539 (* Start(statement) *)
3540 symSet[ 9, 0] := {T.identSym};
3541 symSet[ 9, 1] := {T.EXITSym-32, T.RETURNSym-32, T.NEWSym-32, T.IFSym-32,
3542 T.CASESym-32, T.WHILESym-32, T.REPEATSym-32, T.FORSym-32};
3543 symSet[ 9, 2] := {T.LOOPSym-64, T.WITHSym-64};
3544 (* ------------------------------------------------------------ *)
3545
3546 (* follow semicolon in FormalParamLists *)
3547 symSet[10, 0] := {T.identSym};
3548 symSet[10, 1] := {T.INSym-32};
3549 symSet[10, 2] := {T.VARSym-64, T.OUTSym-64};
3550 (* ------------------------------------------------------------ *)
3551
3552 (* Follow(FPsection-repetition) *)
3553 symSet[11, 0] := {T.rparenSym};
3554 symSet[11, 1] := {};
3555 symSet[11, 2] := {};
3556 (* ------------------------------------------------------------ *)
3557
3558 (* Follow(simpleExpression) - Follow(expression) *)
3559 symSet[12, 0] := {T.equalSym, T.hashSym};
3560 symSet[12, 1] := {T.lessSym-32, T.lessequalSym-32, T.greaterSym-32,
3561 T.greaterequalSym-32, T.INSym-32, T.ISSym-32};
3562 symSet[12, 2] := {};
3563 (* ------------------------------------------------------------ *)
3564 END CPascalP.
3565
[FORK] Old GPCP with patches
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024