separate (Par)
package body Tchk is
type Position is (SC, BC, AP);
procedure Check_Token (T : Token_Type; P : Position);
pragma Inline (Check_Token);
procedure Wrong_Token (T : Token_Type; P : Position);
procedure Check_Token (T : Token_Type; P : Position) is
begin
if Token = T then
Scan;
return;
else
Wrong_Token (T, P);
end if;
end Check_Token;
procedure T_Abort is
begin
Check_Token (Tok_Abort, SC);
end T_Abort;
procedure T_Arrow is
begin
if Token = Tok_Arrow then
Scan;
elsif Token = Tok_Then then
Error_Msg_BC ("missing ""=>""");
Scan;
elsif Token = Tok_Colon_Equal then
Error_Msg_SC (""":="" should be ""=>""");
Scan;
else
Error_Msg_AP ("missing ""=>""");
end if;
end T_Arrow;
procedure T_At is
begin
Check_Token (Tok_At, SC);
end T_At;
procedure T_Body is
begin
Check_Token (Tok_Body, BC);
end T_Body;
procedure T_Box is
begin
if Token = Tok_Box then
Scan;
else
Error_Msg_AP ("missing ""<>""");
end if;
end T_Box;
procedure T_Colon is
begin
if Token = Tok_Colon then
Scan;
else
Error_Msg_AP ("missing "":""");
end if;
end T_Colon;
procedure T_Colon_Equal is
begin
if Token = Tok_Colon_Equal then
Scan;
elsif Token = Tok_Equal then
Error_Msg_SC ("""="" should be "":=""");
Scan;
elsif Token = Tok_Colon then
Error_Msg_SC (""":"" should be "":=""");
Scan;
elsif Token = Tok_Is then
Error_Msg_SC ("IS should be "":=""");
Scan;
else
Error_Msg_AP ("missing "":=""");
end if;
end T_Colon_Equal;
procedure T_Comma is
begin
if Token = Tok_Comma then
Scan;
else
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
end if;
if Token = Tok_Comma then
Scan;
else
Error_Msg_AP ("missing "",""");
end if;
end if;
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
end if;
end T_Comma;
procedure T_Dot_Dot is
begin
if Token = Tok_Dot_Dot then
Scan;
else
Error_Msg_AP ("missing ""..""");
end if;
end T_Dot_Dot;
procedure T_For is
begin
Check_Token (Tok_For, AP);
end T_For;
procedure T_Greater_Greater is
begin
if Token = Tok_Greater_Greater then
Scan;
else
Error_Msg_AP ("missing "">>""");
end if;
end T_Greater_Greater;
procedure T_Identifier is
begin
if Token = Tok_Identifier then
Scan;
elsif Token in Token_Class_Literal then
Error_Msg_SC ("identifier expected");
Scan;
else
Error_Msg_AP ("identifier expected");
end if;
end T_Identifier;
procedure T_In is
begin
Check_Token (Tok_In, AP);
end T_In;
procedure T_Is is
begin
if Token = Tok_Is then
Scan;
Ignore (Tok_Semicolon);
elsif Token = Tok_Arrow
or else Token = Tok_Of
or else Token = Tok_Equal
then
Error_Msg_SC ("missing IS");
Scan; else
Wrong_Token (Tok_Is, AP);
end if;
while Token = Tok_Is loop
Error_Msg_SC ("extra IS ignored");
Scan;
end loop;
end T_Is;
procedure T_Left_Paren is
begin
if Token = Tok_Left_Paren then
Scan;
else
Error_Msg_AP ("missing ""(""");
end if;
end T_Left_Paren;
procedure T_Loop is
begin
if Token = Tok_Do then
Error_Msg_SC ("LOOP expected");
Scan;
else
Check_Token (Tok_Loop, AP);
end if;
end T_Loop;
procedure T_Mod is
begin
Check_Token (Tok_Mod, AP);
end T_Mod;
procedure T_New is
begin
Check_Token (Tok_New, AP);
end T_New;
procedure T_Of is
begin
Check_Token (Tok_Of, AP);
end T_Of;
procedure T_Or is
begin
Check_Token (Tok_Or, AP);
end T_Or;
procedure T_Private is
begin
Check_Token (Tok_Private, SC);
end T_Private;
procedure T_Range is
begin
Check_Token (Tok_Range, AP);
end T_Range;
procedure T_Record is
begin
Check_Token (Tok_Record, AP);
end T_Record;
procedure T_Right_Paren is
begin
if Token = Tok_Right_Paren then
Scan;
else
Error_Msg_AP ("missing "")""");
end if;
end T_Right_Paren;
procedure T_Semicolon is
begin
if Token = Tok_Semicolon then
Scan;
if Token = Tok_Semicolon then
Error_Msg_SC ("extra "";"" ignored");
Scan;
end if;
elsif Token = Tok_Colon then
Error_Msg_SC (""":"" should be "";""");
Scan;
elsif Token = Tok_Comma then
Error_Msg_SC (""","" should be "";""");
Scan;
elsif Token = Tok_Dot then
Error_Msg_SC ("""."" should be "";""");
Scan;
elsif Prev_Token = Tok_Semicolon then
return;
elsif Token = Tok_Vertical_Bar then
Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
Resync_Past_Semicolon;
else
Error_Msg_AP ("|missing "";""");
return;
end if;
end T_Semicolon;
procedure T_Then is
begin
Check_Token (Tok_Then, AP);
end T_Then;
procedure T_Type is
begin
Check_Token (Tok_Type, BC);
end T_Type;
procedure T_Use is
begin
Check_Token (Tok_Use, SC);
end T_Use;
procedure T_When is
begin
Check_Token (Tok_When, SC);
end T_When;
procedure T_With is
begin
Check_Token (Tok_With, BC);
end T_With;
procedure TF_Arrow is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Arrow then
Scan;
elsif Token = Tok_Colon_Equal then
T_Arrow;
else
T_Arrow; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Arrow then
Scan; return;
end if;
end loop;
end if;
end TF_Arrow;
procedure TF_Is is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Is then
T_Is;
elsif Token = Tok_Of
or else Token = Tok_Arrow
or else Token = Tok_Equal
then
T_Is;
else
T_Is; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Is
or else Token = Tok_Of
or else Token = Tok_Arrow
then
Scan; return;
end if;
end loop;
end if;
end TF_Is;
procedure TF_Loop is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Loop then
Scan;
elsif Token = Tok_Then or else Token = Tok_Do then
T_Loop;
else
T_Loop; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Loop or else Token = Tok_Then then
Scan; return;
end if;
end loop;
end if;
end TF_Loop;
procedure TF_Return is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Return then
Scan;
else
Error_Msg_SC ("missing RETURN");
Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Return then
Scan; return;
end if;
end loop;
end if;
end TF_Return;
procedure TF_Semicolon is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Semicolon then
T_Semicolon;
return;
elsif Prev_Token = Tok_Semicolon then
return;
else
if Token = Tok_Pragma then
P_Pragmas_Misplaced;
if Token = Tok_Semicolon then
T_Semicolon;
return;
end if;
end if;
T_Semicolon; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Semicolon then
T_Semicolon;
return;
elsif Token in Token_Class_After_SM then
return;
end if;
end loop;
end if;
end TF_Semicolon;
procedure TF_Then is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Then then
Scan;
else
T_Then; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Then then
Scan; return;
end if;
end loop;
end if;
end TF_Then;
procedure TF_Use is
Scan_State : Saved_Scan_State;
begin
if Token = Tok_Use then
Scan;
else
T_Use; Save_Scan_State (Scan_State);
loop
if Prev_Token_Ptr < Current_Line_Start
or else Token = Tok_Semicolon
or else Token = Tok_EOF
then
Restore_Scan_State (Scan_State); return;
end if;
Scan;
if Token = Tok_Use then
Scan; return;
end if;
end loop;
end if;
end TF_Use;
procedure Wrong_Token (T : Token_Type; P : Position) is
Missing : constant String := "missing ";
Image : constant String := Token_Type'Image (T);
Tok_Name : constant String := Image (5 .. Image'Length);
M : String (1 .. Missing'Length + Tok_Name'Length);
begin
M (1 .. Missing'Length) := Missing;
M (Missing'Length + 1 .. M'Last) := Tok_Name;
if Token = Tok_Semicolon then
Scan;
if Token = T then
Error_Msg_SP ("extra "";"" ignored");
Scan;
else
Error_Msg_SP (M);
end if;
elsif Token = Tok_Comma then
Scan;
if Token = T then
Error_Msg_SP ("extra "","" ignored");
Scan;
else
Error_Msg_SP (M);
end if;
else
case P is
when SC => Error_Msg_SC (M);
when BC => Error_Msg_BC (M);
when AP => Error_Msg_AP (M);
end case;
end if;
end Wrong_Token;
end Tchk;