mirrored from git://gcc.gnu.org/git/gcc.git
-
Notifications
You must be signed in to change notification settings - Fork 4.3k
/
par.adb
1797 lines (1494 loc) · 80.6 KB
/
par.adb
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
------------------------------------------------------------------------------
-- --
-- GNAT COMPILER COMPONENTS --
-- --
-- P A R --
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
-- Public License distributed with GNAT; see file COPYING3. If not, go to --
-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Aspects; use Aspects;
with Atree; use Atree;
with Casing; use Casing;
with Debug; use Debug;
with Elists; use Elists;
with Errout; use Errout;
with Fname; use Fname;
with Lib; use Lib;
with Namet; use Namet;
with Namet.Sp; use Namet.Sp;
with Nlists; use Nlists;
with Nmake; use Nmake;
with Opt; use Opt;
with Output; use Output;
with Par_SCO; use Par_SCO;
with Restrict; use Restrict;
with Scans; use Scans;
with Scn; use Scn;
with Sem_Util; use Sem_Util;
with Sinput; use Sinput;
with Sinput.L; use Sinput.L;
with Sinfo; use Sinfo;
with Sinfo.Nodes; use Sinfo.Nodes;
with Sinfo.Utils; use Sinfo.Utils;
with Snames; use Snames;
with Stringt; use Stringt;
with Style;
with Stylesw; use Stylesw;
with Table;
with Tbuild; use Tbuild;
---------
-- Par --
---------
function Par (Configuration_Pragmas : Boolean) return List_Id is
Inside_Record_Definition : Boolean := False;
-- True within a record definition. Used to control warning for
-- redefinition of standard entities (not issued for field names).
Loop_Block_Count : Nat := 0;
-- Counter used for constructing loop/block names (see the routine
-- Par.Ch5.Get_Loop_Block_Name).
Num_Library_Units : Natural := 0;
-- Count number of units parsed (relevant only in syntax check only mode,
-- since in semantics check mode only a single unit is permitted anyway).
Save_Config_Attrs : Config_Switches_Type;
-- Variable used to save values of config switches while we parse the
-- new unit, to be restored on exit for proper recursive behavior.
Inside_Delta_Aggregate : Boolean := False;
-- True within a delta aggregate (but only after the "delta" token has
-- been scanned). Used to distinguish syntax errors from syntactically
-- correct "deep" delta aggregates (enabled via -gnatX0).
Save_Style_Checks : Style_Check_Options;
Save_Style_Check : Boolean;
-- Variables for storing the original state of whether style checks should
-- be active in general and which particular ones should be checked.
--------------------
-- Error Recovery --
--------------------
-- When an error is encountered, a call is made to one of the Error_Msg
-- routines to record the error. If the syntax scan is not derailed by the
-- error (e.g. a complaint that logical operators are inconsistent in an
-- EXPRESSION), then control returns from the Error_Msg call, and the
-- parse continues unimpeded.
-- If on the other hand, the Error_Msg represents a situation from which
-- the parser cannot recover locally, the exception Error_Resync is raised
-- immediately after the call to Error_Msg. Handlers for Error_Resync
-- are located at strategic points to resynchronize the parse. For example,
-- when an error occurs in a statement, the handler skips to the next
-- semicolon and continues the scan from there.
-- Each parsing procedure contains a note with the heading "Error recovery"
-- which shows if it can propagate the Error_Resync exception. In order
-- not to propagate the exception, a procedure must either contain its own
-- handler for this exception, or it must not call any other routines which
-- propagate the exception.
-- Note: the arrangement of Error_Resync handlers is such that it should
-- never be possible to transfer control through a procedure which made
-- an entry in the scope stack, invalidating the contents of the stack.
Error_Resync : exception;
-- Exception raised on error that is not handled locally, see above
Last_Resync_Point : Source_Ptr;
-- The resynchronization routines in Par.Sync run a risk of getting
-- stuck in an infinite loop if they do not skip a token, and the caller
-- keeps repeating the same resync call. On the other hand, if they skip
-- a token unconditionally, some recovery opportunities are missed. The
-- variable Last_Resync_Point records the token location previously set
-- by a Resync call, and if a subsequent Resync call occurs at the same
-- location, then the Resync routine does guarantee to skip a token.
--------------------------------------------
-- Handling Semicolon Used in Place of IS --
--------------------------------------------
-- The following global variables are used in handling the error situation
-- of using a semicolon in place of IS in a subprogram declaration as in:
-- procedure X (Y : Integer);
-- Q : Integer;
-- begin
-- ...
-- end;
-- The two contexts in which this can appear are at the outer level, and
-- within a declarative region. At the outer level, we know something is
-- wrong as soon as we see the Q (or begin, if there are no declarations),
-- and we can immediately decide that the semicolon should have been IS.
-- The situation in a declarative region is more complex. The declaration
-- of Q could belong to the outer region, and we do not know that we have
-- an error until we hit the begin. It is still not clear at this point
-- from a syntactic point of view that something is wrong, because the
-- begin could belong to the enclosing subprogram or package. However, we
-- can incorporate a bit of semantic knowledge and note that the body of
-- X is missing, so we definitely DO have an error. We diagnose this error
-- as semicolon in place of IS on the subprogram line.
-- There are two styles for this diagnostic. If the begin immediately
-- follows the semicolon, then we can place a flag (IS expected) right
-- on the semicolon. Otherwise we do not detect the error until we hit
-- the begin which refers back to the line with the semicolon.
-- To control the process in the second case, the following global
-- variables are set to indicate that we have a subprogram declaration
-- whose body is required and has not yet been found. The prefix SIS
-- stands for "Subprogram IS" handling.
SIS_Entry_Active : Boolean := False;
-- Set True to indicate that an entry is active (i.e. that a subprogram
-- declaration has been encountered, and no body for this subprogram
-- has been encountered). The remaining variables other than
-- SIS_Aspect_Import_Seen are valid only if this is True.
SIS_Aspect_Import_Seen : Boolean := False;
-- If this is True when a subprogram declaration has been encountered, we
-- do not set SIS_Entry_Active, because the Import means there is no body.
-- Set False at the start of P_Subprogram, set True when an Import aspect
-- specification is seen, and used when P_Subprogram finds a subprogram
-- declaration. This is necessary because the aspects are parsed before
-- we know we have a subprogram declaration.
SIS_Labl : Node_Id;
-- Subprogram designator
SIS_Sloc : Source_Ptr;
-- Source location of FUNCTION/PROCEDURE keyword
SIS_Ecol : Column_Number;
-- Column number of FUNCTION/PROCEDURE keyword
SIS_Semicolon_Sloc : Source_Ptr;
-- Source location of semicolon at end of subprogram declaration
SIS_Declaration_Node : Node_Id;
-- Pointer to tree node for subprogram declaration
SIS_Missing_Semicolon_Message : Error_Msg_Id;
-- Used to save message ID of missing semicolon message (which will be
-- modified to missing IS if necessary). Set to No_Error_Msg in the
-- normal (non-error) case.
-- Five things can happen to an active SIS entry
-- 1. If a BEGIN is encountered with an SIS entry active, then we have
-- exactly the situation in which we know the body of the subprogram is
-- missing. After posting an error message, we change the spec to a body,
-- rechaining the declarations that intervened between the spec and BEGIN.
-- 2. Another subprogram declaration or body is encountered. In this
-- case the entry gets overwritten with the information for the new
-- subprogram declaration. We don't catch some nested cases this way,
-- but it doesn't seem worth the effort.
-- 3. A nested declarative region (e.g. package declaration or package
-- body) is encountered. The SIS active indication is reset at the start
-- of such a nested region. Again, like case 2, this causes us to miss
-- some nested cases, but it doesn't seen worth the effort to stack and
-- unstack the SIS information. Maybe we will reconsider this if we ever
-- get a complaint about a missed case.
-- 4. We encounter a valid pragma INTERFACE or IMPORT that effectively
-- supplies the missing body. In this case we reset the entry.
-- 5. We encounter the end of the declarative region without encountering
-- a BEGIN first. In this situation we simply reset the entry. We know
-- that there is a missing body, but it seems more reasonable to let the
-- later semantic checking discover this.
----------------------------------------------------
-- Handling of Reserved Words Used as Identifiers --
----------------------------------------------------
-- Note: throughout the parser, the terms reserved word and keyword are
-- used interchangeably to refer to the same set of reserved keywords
-- (including until, protected, etc).
-- If a reserved word is used in place of an identifier, the parser where
-- possible tries to recover gracefully. In particular, if the keyword is
-- clearly spelled using identifier casing, e.g. Until in a source program
-- using mixed case identifiers and lower case keywords, then the keyword
-- is treated as an identifier if it appears in a place where an identifier
-- is required.
-- The situation is more complex if the keyword is spelled with normal
-- keyword casing. In this case, the parser is more reluctant to consider
-- it to be intended as an identifier, unless it has some further
-- confirmation.
-- In the case of an identifier appearing in the identifier list of a
-- declaration, the appearance of a comma or colon right after the keyword
-- on the same line is taken as confirmation. For an enumeration literal,
-- a comma or right paren right after the identifier is also treated as
-- adequate confirmation.
-- The following type is used in calls to Is_Reserved_Identifier and
-- also to P_Defining_Identifier and P_Identifier. The default for all
-- these functions is that reserved words in reserved word case are not
-- considered to be reserved identifiers. The Id_Check value indicates
-- tokens, which if they appear immediately after the identifier, are
-- taken as confirming that the use of an identifier was expected
type Id_Check is
(None,
-- Default, no special token test
C_Comma_Right_Paren,
-- Consider as identifier if followed by comma or right paren
C_Comma_Colon,
-- Consider as identifier if followed by comma or colon
C_Do,
-- Consider as identifier if followed by DO
C_Dot,
-- Consider as identifier if followed by period
C_Greater_Greater,
-- Consider as identifier if followed by >>
C_In,
-- Consider as identifier if followed by IN
C_Is,
-- Consider as identifier if followed by IS
C_Left_Paren_Semicolon,
-- Consider as identifier if followed by left paren or semicolon
C_Use,
-- Consider as identifier if followed by USE
C_Vertical_Bar_Arrow);
-- Consider as identifier if followed by | or =>
--------------------------------------------
-- Handling IS Used in Place of Semicolon --
--------------------------------------------
-- This is a somewhat trickier situation, and we can't catch it in all
-- cases, but we do our best to detect common situations resulting from
-- a "cut and paste" operation which forgets to change the IS to semicolon.
-- Consider the following example:
-- package body X is
-- procedure A;
-- procedure B is
-- procedure C;
-- ...
-- procedure D is
-- begin
-- ...
-- end;
-- begin
-- ...
-- end;
-- The trouble is that the section of text from PROCEDURE B through END;
-- constitutes a valid procedure body, and the danger is that we find out
-- far too late that something is wrong (indeed most compilers will behave
-- uncomfortably on the above example).
-- We have two approaches to helping to control this situation. First we
-- make every attempt to avoid swallowing the last END; if we can be sure
-- that some error will result from doing so. In particular, we won't
-- accept the END; unless it is exactly correct (in particular it must not
-- have incorrect name tokens), and we won't accept it if it is immediately
-- followed by end of file, WITH or SEPARATE (all tokens that unmistakeably
-- signal the start of a compilation unit, and which therefore allow us to
-- reserve the END; for the outer level.) For more details on this aspect
-- of the handling, see package Par.Endh.
-- If we can avoid eating up the END; then the result in the absence of
-- any additional steps would be to post a missing END referring back to
-- the subprogram with the bogus IS. Similarly, if the enclosing package
-- has no BEGIN, then the result is a missing BEGIN message, which again
-- refers back to the subprogram header.
-- Such an error message is not too bad (it's already a big improvement
-- over what many parsers do), but it's not ideal, because the declarations
-- following the IS have been absorbed into the wrong scope. In the above
-- case, this could result for example in a bogus complaint that the body
-- of D was missing from the package.
-- To catch at least some of these cases, we take the following additional
-- steps. First, a subprogram body is marked as having a suspicious IS if
-- the declaration line is followed by a line which starts with a symbol
-- that can start a declaration in the same column, or to the left of the
-- column in which the FUNCTION or PROCEDURE starts (normal style is to
-- indent any declarations which really belong a subprogram). If such a
-- subprogram encounters a missing BEGIN or missing END, then we decide
-- that the IS should have been a semicolon, and the subprogram body node
-- is marked (by setting the Bad_Is_Detected flag true. Note that we do
-- not do this for library level procedures, only for nested procedures,
-- since for library level procedures, we must have a body.
-- The processing for a declarative part checks to see if the last
-- declaration scanned is marked in this way, and if it is, the tree
-- is modified to reflect the IS being interpreted as a semicolon.
---------------------------------------------------
-- Parser Type Definitions and Control Variables --
---------------------------------------------------
-- The following variable and associated type declaration are used by the
-- expression parsing routines to return more detailed information about
-- the categorization of a parsed expression.
type Expr_Form_Type is (
EF_Simple_Name, -- Simple name, i.e. possibly qualified identifier
EF_Name, -- Simple expression which could also be a name
EF_Simple, -- Simple expression which is not call or name
EF_Range_Attr, -- Range attribute reference
EF_Non_Simple); -- Expression that is not a simple expression
Expr_Form : Expr_Form_Type;
-- The following type is used by P_Subprogram, P_Package, to indicate which
-- of several possibilities is acceptable.
type Pf_Rec is record
Spcn : Boolean; -- True if specification OK
Decl : Boolean; -- True if declaration OK
Gins : Boolean; -- True if generic instantiation OK
Pbod : Boolean; -- True if proper body OK
Rnam : Boolean; -- True if renaming declaration OK
Stub : Boolean; -- True if body stub OK
Pexp : Boolean; -- True if parameterized expression OK
end record;
pragma Pack (Pf_Rec);
function T return Boolean renames True;
function F return Boolean renames False;
Pf_Decl_Gins_Pbod_Rnam_Stub_Pexp : constant Pf_Rec := (F, T, T, T, T, T, T);
Pf_Decl_Pexp : constant Pf_Rec := (F, T, F, F, F, F, T);
Pf_Decl_Gins_Pbod_Rnam_Pexp : constant Pf_Rec := (F, T, T, T, T, F, T);
Pf_Decl_Pbod_Pexp : constant Pf_Rec := (F, T, F, T, F, F, T);
Pf_Pbod_Pexp : constant Pf_Rec := (F, F, F, T, F, F, T);
Pf_Spcn : constant Pf_Rec := (T, F, F, F, F, F, F);
-- The above are the only allowed values of Pf_Rec arguments
type SS_Rec is record
Eftm : Boolean; -- ELSIF can terminate sequence
Eltm : Boolean; -- ELSE can terminate sequence
Extm : Boolean; -- EXCEPTION can terminate sequence
Ortm : Boolean; -- OR can terminate sequence
Sreq : Boolean; -- at least one statement required
Tatm : Boolean; -- THEN ABORT can terminate sequence
Whtm : Boolean; -- WHEN can terminate sequence
Unco : Boolean; -- Unconditional terminate after one statement
end record;
pragma Pack (SS_Rec);
SS_Eftm_Eltm_Sreq : constant SS_Rec := (T, T, F, F, T, F, F, F);
SS_Eltm_Ortm_Tatm : constant SS_Rec := (F, T, F, T, F, T, F, F);
SS_Extm_Sreq : constant SS_Rec := (F, F, T, F, T, F, F, F);
SS_None : constant SS_Rec := (F, F, F, F, F, F, F, F);
SS_Ortm_Sreq : constant SS_Rec := (F, F, F, T, T, F, F, F);
SS_Sreq : constant SS_Rec := (F, F, F, F, T, F, F, F);
SS_Sreq_Whtm : constant SS_Rec := (F, F, F, F, T, F, T, F);
SS_Whtm : constant SS_Rec := (F, F, F, F, F, F, T, F);
SS_Unco : constant SS_Rec := (F, F, F, F, F, F, F, T);
Goto_List : Elist_Id;
-- List of goto nodes appearing in the current compilation. Used to
-- recognize natural loops and convert them into bona fide loops for
-- optimization purposes.
Label_List : Elist_Id;
-- List of label nodes for labels appearing in the current compilation.
-- Used by Par.Labl to construct the corresponding implicit declarations.
-----------------
-- Scope Table --
-----------------
-- The scope table, also referred to as the scope stack, is used to record
-- the current scope context. It is organized as a stack, with inner nested
-- entries corresponding to higher entries on the stack. An entry is made
-- when the parser encounters the opening of a nested construct (such as a
-- record, task, package etc.), and then package Par.Endh uses this stack
-- to deal with END lines (including properly dealing with END nesting
-- errors).
type SS_End_Type is
-- Type of end entry required for this scope. The last two entries are
-- used only in the subprogram body case to mark the case of a suspicious
-- IS, or a bad IS (i.e. suspicions confirmed by missing BEGIN or END).
-- See separate section on dealing with IS used in place of semicolon.
-- Note that for many purposes E_Name, E_Suspicious_Is and E_Bad_Is are
-- treated the same (E_Suspicious_Is and E_Bad_Is are simply special cases
-- of E_Name). They are placed at the end of the enumeration so that a
-- test for >= E_Name catches all three cases efficiently.
(E_Dummy, -- dummy entry at outer level
E_Case, -- END CASE;
E_If, -- END IF;
E_Loop, -- END LOOP;
E_Record, -- END RECORD;
E_Return, -- END RETURN;
E_Select, -- END SELECT;
E_Name, -- END [name];
E_Suspicious_Is, -- END [name]; (case of suspicious IS)
E_Bad_Is); -- END [name]; (case of bad IS)
-- The following describes a single entry in the scope table
type Scope_Table_Entry is record
Etyp : SS_End_Type;
-- Type of end entry, as per above description
Lreq : Boolean;
-- A flag indicating whether the label, if present, is required to
-- appear on the end line. It is referenced only in the case of Etyp is
-- equal to E_Name or E_Suspicious_Is where the name may or may not be
-- required (yes for labeled block, no in other cases). Note that for
-- all cases except begin, the question of whether a label is required
-- can be determined from the other fields (for loop, it is required if
-- it is present, and for the other constructs it is never required or
-- allowed).
Ecol : Column_Number;
-- Contains the absolute column number (with tabs expanded) of the
-- expected column of the end assuming normal Ada indentation usage. If
-- the RM_Column_Check mode is set, this value is used for generating
-- error messages about indentation. Otherwise it is used only to
-- control heuristic error recovery actions. This value is zero origin.
Labl : Node_Id;
-- This field is used to provide the name of the construct being parsed
-- and indirectly its kind. For loops and blocks, the field contains the
-- source name or the generated one. For package specifications, bodies,
-- subprogram specifications and bodies the field holds the
-- corresponding program unit name. For task declarations and bodies,
-- protected types and bodies, and accept statements the field hold the
-- name of the type or operation. For if-statements, case-statements,
-- return statements, and selects, the field is initialized to Error.
-- Note: this is a bit of an odd (mis)use of Error, since there is no
-- Error, but we use this value as a place holder to indicate that it
-- is an error to have a label on the end line.
-- Whenever the field is a name, it is attached to the parent node of
-- the construct being parsed. Thus the parent node indicates the kind
-- of construct whose parse tree is being built. This is used in error
-- recovery.
Decl : List_Id;
-- Points to the list of declarations (i.e. the declarative part)
-- associated with this construct. It is set only in the END [name]
-- cases, and is set to No_List for all other cases which do not have a
-- declarative unit associated with them. This is used for determining
-- the proper location for implicit label declarations.
Node : Node_Id;
-- Empty except in the case of entries for IF and CASE statements, in
-- which case it contains the N_If_Statement or N_Case_Statement node.
-- This is used for setting the End_Span field.
Sloc : Source_Ptr;
-- Source location of the opening token of the construct. This is used
-- to refer back to this line in error messages (such as missing or
-- incorrect end lines). The Sloc field is not used, and is not set, if
-- a label is present (the Labl field provides the text name of the
-- label in this case, which is fine for error messages).
S_Is : Source_Ptr;
-- S_Is is relevant only if Etyp is set to E_Suspicious_Is or E_Bad_Is.
-- It records the location of the IS that is considered to be
-- suspicious.
Junk : Boolean;
-- A boolean flag that is set true if the opening entry is the dubious
-- result of some prior error, e.g. a record entry where the record
-- keyword was missing. It is used to suppress the issuing of a
-- corresponding junk complaint about the end line (we do not want
-- to complain about a missing end record when there was no record).
end record;
-- The following declares the scope table itself. The Last field is the
-- stack pointer, so that Scope.Table (Scope.Last) is the top entry. The
-- oldest entry, at Scope_Stack (0), is a dummy entry with Etyp set to
-- E_Dummy, and the other fields undefined. This dummy entry ensures that
-- Scope_Stack (Scope_Stack_Ptr).Etyp can always be tested, and that the
-- scope stack pointer is always in range.
package Scope is new Table.Table (
Table_Component_Type => Scope_Table_Entry,
Table_Index_Type => Int,
Table_Low_Bound => 0,
Table_Initial => 50,
Table_Increment => 100,
Table_Name => "Scope");
type Scope_Table_Entry_Ptr is access all Scope_Table_Entry;
function Scopes (Index : Int) return Scope_Table_Entry_Ptr;
-- Return the indicated Scope_Table_Entry. We use a pointer for
-- efficiency. Callers should not save the pointer, but should do things
-- like Scopes (Scope.Last).Something. Note that there is one place in
-- Par.Ch5 that indexes the stack out of bounds, and can't call this.
function Scopes (Index : Int) return Scope_Table_Entry_Ptr is
begin
pragma Assert (Index in Scope.First .. Scope.Last);
return Scope.Table (Index)'Unrestricted_Access;
end Scopes;
------------------------------------------
-- Table for Handling Suspicious Labels --
------------------------------------------
-- This is a special data structure which is used to deal very specifically
-- with the following error case
-- label;
-- loop
-- ...
-- end loop label;
-- Similar cases apply to FOR, WHILE, DECLARE, or BEGIN
-- In each case the opening line looks like a procedure call because of
-- the semicolon. And the end line looks illegal because of an unexpected
-- label. If we did nothing special, we would just diagnose the label on
-- the end as unexpected. But that does not help point to the real error
-- which is that the semicolon after label should be a colon.
-- To deal with this, we build an entry in the Suspicious_Labels table
-- whenever we encounter an identifier followed by a semicolon, followed
-- by one of LOOP, FOR, WHILE, DECLARE, BEGIN. Then this entry is used to
-- issue the right message when we hit the END that confirms that this was
-- a bad label.
type Suspicious_Label_Entry is record
Proc_Call : Node_Id;
-- Node for the procedure call statement built for the label; construct
Semicolon_Loc : Source_Ptr;
-- Location of the possibly wrong semicolon
Start_Token : Source_Ptr;
-- Source location of the LOOP, FOR, WHILE, DECLARE, BEGIN token
end record;
package Suspicious_Labels is new Table.Table (
Table_Component_Type => Suspicious_Label_Entry,
Table_Index_Type => Int,
Table_Low_Bound => 1,
Table_Initial => 50,
Table_Increment => 100,
Table_Name => "Suspicious_Labels");
-- Now when we are about to issue a message complaining about an END label
-- that should not be there because it appears to end a construct that has
-- no label, we first search the suspicious labels table entry, using the
-- source location stored in the scope table as a key. If we find a match,
-- then we check that the label on the end matches the name in the call,
-- and if so, we issue a message saying the semicolon should be a colon.
-- Quite a bit of work, but really helpful in the case where it helps, and
-- the need for this is based on actual experience with tracking down this
-- kind of error (the eye often easily mistakes semicolon for colon).
-- Note: we actually have enough information to patch up the tree, but
-- this may not be worth the effort. Also we could deal with the same
-- situation for EXIT with a label, but for now don't bother with that.
Current_Assign_Node : Node_Id := Empty;
-- This is the node of the current assignment statement being compiled.
-- It is used to record the presence of target_names on its RHS. This
-- context-dependent trick simplifies the analysis of such nodes, where
-- the RHS must first be analyzed with expansion disabled.
---------------------------------
-- Parsing Routines by Chapter --
---------------------------------
-- Uncommented declarations in this section simply parse the construct
-- corresponding to their name, and return an ID value for the Node or
-- List that is created.
-------------
-- Par.Ch2 --
-------------
package Ch2 is
function P_Pragma (Skipping : Boolean := False) return Node_Id;
-- Scan out a pragma. If Skipping is True, then the caller is skipping
-- the pragma in the context of illegal placement (this is used to avoid
-- some junk cascaded messages). Some pragmas must be dealt with during
-- the parsing phase (e.g. pragma Page, since we can generate a listing
-- in syntax only mode). It is possible that the parser uses the rescan
-- logic (using Save/Restore_Scan_State) with the effect of calling this
-- procedure more than once for the same pragma. All parse-time pragma
-- handling must be prepared to handle such multiple calls correctly.
function P_Identifier
(C : Id_Check := None;
Force_Msg : Boolean := False) return Node_Id;
-- Scans out an identifier. The parameter C determines the treatment
-- of reserved identifiers. See declaration of Id_Check for details.
-- An appropriate error message, pointing to the token, is also issued
-- if either this is the first occurrence of misuse of this identifier,
-- or if Force_Msg is True.
function P_Interpolated_String_Literal return Node_Id;
function P_Pragmas_Opt return List_Id;
-- This function scans for a sequence of pragmas in other than a
-- declaration sequence or statement sequence context. All pragmas
-- can appear except pragmas Assert and Debug, which are only allowed
-- in a declaration or statement sequence context.
procedure P_Pragmas_Misplaced;
-- Skips misplaced pragmas with a complaint
procedure P_Pragmas_Opt (List : List_Id);
-- Parses optional pragmas and appends them to the List
end Ch2;
-------------
-- Par.Ch3 --
-------------
package Ch3 is
Missing_Begin_Msg : Error_Msg_Id;
-- This variable is set by a call to P_Declarative_Part. Normally it
-- is set to No_Error_Msg, indicating that no special processing is
-- required by the caller. The special case arises when a statement
-- is found in the sequence of declarations. In this case the Id of
-- the message issued ("declaration expected") is preserved in this
-- variable, then the caller can change it to an appropriate missing
-- begin message if indeed the BEGIN is missing.
function P_Array_Type_Definition return Node_Id;
function P_Constraint_Opt return Node_Id;
function P_Declarative_Part return List_Id;
function P_Discrete_Choice_List return List_Id;
function P_Discrete_Range return Node_Id;
function P_Discrete_Subtype_Definition return Node_Id;
function P_Known_Discriminant_Part_Opt return List_Id;
function P_Signed_Integer_Type_Definition return Node_Id;
function P_Range return Node_Id;
function P_Range_Constraint return Node_Id;
function P_Record_Definition return Node_Id;
function P_Subtype_Mark return Node_Id;
function P_Subtype_Mark_Resync return Node_Id;
function P_Unknown_Discriminant_Part_Opt return Boolean;
procedure P_Declarative_Items
(Decls : List_Id;
Declare_Expression : Boolean;
In_Spec : Boolean;
In_Statements : Boolean);
-- Parses a sequence of zero or more declarative items, and appends them
-- to Decls. Done indicates whether or not there might be additional
-- declarative items to parse. If Done is True, then there are no more
-- to parse; otherwise there might be more.
--
-- Declare_Expression is true if we are parsing a declare_expression, in
-- which case we want to suppress certain style checking.
--
-- In_Spec is true if we are scanning a package declaration, and is used
-- to generate an appropriate message if a statement is encountered in
-- such a context.
--
-- In_Statements is true if we are called to parse declarative items in
-- a sequence of statements. In this case, we do not give an error upon
-- encountering a statement, but return to the caller with Done = True,
-- so the caller can resume parsing statements.
function P_Basic_Declarative_Items
(Declare_Expression : Boolean) return List_Id;
-- Used to parse the declarative items in a package visible or
-- private part (in which case Declare_Expression is False), and
-- the declare_items of a declare_expression (in which case
-- Declare_Expression is True). Declare_Expression is used to
-- affect the wording of error messages, and to control style
-- checking.
function P_Access_Definition
(Null_Exclusion_Present : Boolean) return Node_Id;
-- Ada 2005 (AI-231/AI-254): The caller parses the null-exclusion part
-- and indicates if it was present
function P_Access_Type_Definition
(Header_Already_Parsed : Boolean := False) return Node_Id;
-- Ada 2005 (AI-254): The formal is used to indicate if the caller has
-- parsed the null_exclusion part. In this case the caller has also
-- removed the ACCESS token
procedure P_Component_Items (Decls : List_Id);
-- Scan out one or more component items and append them to the given
-- list. Only scans out more than one declaration in the case where the
-- source has a single declaration with multiple defining identifiers.
function P_Defining_Identifier (C : Id_Check := None) return Node_Id;
-- Scan out a defining identifier. The parameter C controls the
-- treatment of errors in case a reserved word is scanned. See the
-- declaration of this type for details.
function P_Interface_Type_Definition
(Abstract_Present : Boolean) return Node_Id;
-- Ada 2005 (AI-251): Parse the interface type definition part. Abstract
-- Present indicates if the reserved word "abstract" has been previously
-- found. It is used to report an error message because interface types
-- are by definition abstract tagged. We generate a record_definition
-- node if the list of interfaces is empty; otherwise we generate a
-- derived_type_definition node (the first interface in this list is the
-- ancestor interface).
function P_Null_Exclusion
(Allow_Anonymous_In_95 : Boolean := False) return Boolean;
-- Ada 2005 (AI-231): Parse the null-excluding part. A True result
-- indicates that the null-excluding part was present.
--
-- Allow_Anonymous_In_95 is True if we are in a context that allows
-- anonymous access types in Ada 95, in which case "not null" is legal
-- if it precedes "access".
function P_Subtype_Indication
(Not_Null_Present : Boolean := False) return Node_Id;
-- Ada 2005 (AI-231): The flag Not_Null_Present indicates that the
-- null-excluding part has been scanned out and it was present.
function P_Range_Or_Subtype_Mark
(Allow_Simple_Expression : Boolean := False) return Node_Id;
-- Scans out a range or subtype mark, and also permits a general simple
-- expression if Allow_Simple_Expression is set to True.
function Init_Expr_Opt (P : Boolean := False) return Node_Id;
-- If an initialization expression is present (:= expression), then
-- it is scanned out and returned, otherwise Empty is returned if no
-- initialization expression is present. This procedure also handles
-- certain common error cases cleanly. The parameter P indicates if
-- a right paren can follow the expression (default = no right paren
-- allowed).
procedure Skip_Declaration (S : List_Id);
-- Used when scanning statements to skip past a misplaced declaration
-- The declaration is scanned out and appended to the given list.
-- Token is known to be a declaration token (in Token_Class_Declk)
-- on entry, so there definition is a declaration to be scanned.
function P_Subtype_Indication
(Subtype_Mark : Node_Id;
Not_Null_Present : Boolean := False) return Node_Id;
-- This version of P_Subtype_Indication is called when the caller has
-- already scanned out the subtype mark which is passed as a parameter.
-- Ada 2005 (AI-231): The flag Not_Null_Present indicates that the
-- null-excluding part has been scanned out and it was present.
function P_Subtype_Mark_Attribute (Type_Node : Node_Id) return Node_Id;
-- Parse a subtype mark attribute. The caller has already parsed the
-- subtype mark, which is passed in as the argument, and has checked
-- that the current token is apostrophe.
end Ch3;
-------------
-- Par.Ch4 --
-------------
package Ch4 is
function P_Aggregate return Node_Id;
function P_Expression return Node_Id;
function P_Expression_Or_Range_Attribute return Node_Id;
function P_Function_Name return Node_Id;
function P_Name return Node_Id;
function P_Qualified_Simple_Name return Node_Id;
function P_Qualified_Simple_Name_Resync return Node_Id;
function P_Simple_Expression return Node_Id;
function P_Simple_Expression_Or_Range_Attribute return Node_Id;
function P_Expression_If_OK return Node_Id;
-- Scans out an expression allowing an unparenthesized case expression,
-- if expression, or quantified expression to appear without enclosing
-- parentheses. However, if such an expression is not preceded by a left
-- paren, and followed by a right paren, an error message will be output
-- noting that parenthesization is required.
function P_Expression_No_Right_Paren return Node_Id;
-- Scans out an expression in contexts where the expression cannot be
-- terminated by a right paren (gives better error recovery if an errant
-- right paren is found after the expression).
function P_Expression_Or_Range_Attribute_If_OK return Node_Id;
-- Scans out an expression or range attribute where a conditional
-- expression is permitted to appear without surrounding parentheses.
-- However, if such an expression is not preceded by a left paren, and
-- followed by a right paren, an error message will be output noting
-- that parenthesization is required.
function P_If_Expression return Node_Id;
-- Scans out an if expression. Called with Token pointing to the
-- IF keyword, and returns pointing to the terminating right paren,
-- semicolon or comma, but does not consume this terminating token.
function P_Qualified_Expression (Subtype_Mark : Node_Id) return Node_Id;
-- This routine scans out a qualified expression when the caller has
-- already scanned out the name and apostrophe of the construct.
function P_Quantified_Expression return Node_Id;
-- This routine scans out a quantified expression when the caller has
-- already scanned out the keyword "for" of the construct.
end Ch4;
-------------
-- Par.Ch5 --
-------------
package Ch5 is
function P_Condition return Node_Id;
-- Scan out and return a condition. Note that an error is given if
-- the condition is followed by a right parenthesis.
function P_Condition (Cond : Node_Id) return Node_Id;
-- Similar to the above, but the caller has already scanned out the
-- conditional expression and passes it as an argument. This form of
-- the call does not check for a following right parenthesis.
function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
-- Parse an iterator specification. The defining identifier has already
-- been scanned, as it is the common prefix between loop and iterator
-- specification.
function P_Loop_Parameter_Specification return Node_Id;
-- Used in loop constructs and quantified expressions.
function P_Sequence_Of_Statements
(SS_Flags : SS_Rec; Handled : Boolean := False) return List_Id;
-- SS_Flags indicates the acceptable termination tokens; see body for
-- details. Handled is true if we are parsing a handled sequence of
-- statements.
procedure Parse_Decls_Begin_End (Parent : Node_Id);
-- Parses declarations and handled statement sequence, setting
-- fields of Parent node appropriately.
end Ch5;
-------------
-- Par.Ch6 --
-------------
package Ch6 is
function P_Designator return Node_Id;
function P_Defining_Program_Unit_Name return Node_Id;
function P_Formal_Part return List_Id;
function P_Parameter_Profile return List_Id;
function P_Return_Statement return Node_Id;
function P_Subprogram_Specification return Node_Id;
procedure P_Mode (Node : Node_Id);
-- Sets In_Present and/or Out_Present flags in Node scanning past IN,
-- OUT or IN OUT tokens in the source.
function P_Subprogram (Pf_Flags : Pf_Rec) return Node_Id;
-- Scans out any construct starting with either of the keywords
-- PROCEDURE or FUNCTION. The parameter indicates which possible
-- possible kinds of construct (body, spec, instantiation etc.)
-- are permissible in the current context.
end Ch6;
-------------
-- Par.Ch7 --
-------------
package Ch7 is
function P_Package (Pf_Flags : Pf_Rec) return Node_Id;
-- Scans out any construct starting with the keyword PACKAGE. The
-- parameter indicates which possible kinds of construct (body, spec,
-- instantiation etc.) are permissible in the current context.
end Ch7;
-------------
-- Par.Ch8 --
-------------
package Ch8 is
procedure P_Use_Clause (Item_List : List_Id);
end Ch8;
-------------
-- Par.Ch9 --
-------------
package Ch9 is
function P_Abort_Statement return Node_Id;
function P_Abortable_Part return Node_Id;
function P_Accept_Statement return Node_Id;
function P_Delay_Statement return Node_Id;
function P_Entry_Body return Node_Id;
function P_Protected return Node_Id;
function P_Requeue_Statement return Node_Id;
function P_Select_Statement return Node_Id;
function P_Task return Node_Id;
function P_Terminate_Alternative return Node_Id;
end Ch9;
--------------
-- Par.Ch10 --
--------------
package Ch10 is
function P_Compilation_Unit return Node_Id;
-- Note: this function scans a single compilation unit, and checks that
-- an end of file follows this unit, diagnosing any unexpected input as
-- an error, and then skipping it, so that Token is set to Tok_EOF on
-- return. An exception is in syntax-only mode, where multiple
-- compilation units are permitted. In this case, P_Compilation_Unit
-- does not check for end of file and there may be more compilation
-- units to scan. The caller can uniquely detect this situation by the
-- fact that Token is not set to Tok_EOF on return.
--
-- What about multiple unit/file capability that now exists???
--
-- The Ignore parameter is normally set False. It is set True in the
-- multiple unit per file mode if we are skipping past a unit that we
-- are not interested in.
end Ch10;
--------------
-- Par.Ch11 --
--------------
package Ch11 is
function P_Handled_Sequence_Of_Statements return Node_Id;
function P_Raise_Expression return Node_Id;
function P_Raise_Statement return Node_Id;
function Parse_Exception_Handlers return List_Id;
-- Parses the partial construct EXCEPTION followed by a list of
-- exception handlers which appears in a number of productions, and
-- returns the list of exception handlers.
end Ch11;
--------------
-- Par.Ch12 --
--------------
package Ch12 is
function P_Generic return Node_Id;