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 | -- Abstract :
--
-- See spec.
--
-- Copyright (C) 2017 - 2023 Free Software Foundation, Inc.
--
-- This library is free software; you can redistribute it and/or modify it
-- under terms of the GNU General Public License as published by the Free
-- Software Foundation; either version 3, or (at your option) any later
-- version. This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN-
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-- As a special exception under Section 7 of GPL version 3, you are granted
-- additional permissions described in the GCC Runtime Library Exception,
-- version 3.1, as published by the Free Software Foundation.
pragma License (Modified_GPL);
with Ada.Characters.Handling;
with WisiToken.Lexer;
package body WisiToken.In_Parse_Actions is
function Image
(Item : in Syntax_Trees.In_Parse_Actions.Status;
Tree : in Syntax_Trees.Tree'Class;
Error_Node : in Syntax_Trees.Valid_Node_Access)
return String
is
use WisiToken.Syntax_Trees;
begin
case Item.Label is
when Syntax_Trees.In_Parse_Actions.Ok =>
return Syntax_Trees.In_Parse_Actions.Status_Label'Image (Item.Label);
when Syntax_Trees.In_Parse_Actions.Error =>
declare
use all type SAL.Base_Peek_Type;
Begin_Node : constant Node_Access :=
(if Item.Begin_Name = 0
then Invalid_Node_Access
else Tree.Child (Error_Node, Item.Begin_Name));
End_Node : constant Node_Access :=
(if Item.End_Name = 0
then Invalid_Node_Access
else Tree.Child (Error_Node, Item.End_Name));
begin
return '(' & Syntax_Trees.In_Parse_Actions.Status_Label'Image (Item.Label) & ", " &
(if Item.Begin_Name = 0 then "<absent>"
else Tree.Image (Begin_Node) & "'" & Tree.Lexer.Buffer_Text
(Tree.Byte_Region (Begin_Node, Trailing_Non_Grammar => False))) & "'," &
(if Item.End_Name = 0 then "<absent>"
else Tree.Image (End_Node) & "'" & Tree.Lexer.Buffer_Text
(Tree.Byte_Region (End_Node, Trailing_Non_Grammar => False))) & "')";
end;
end case;
end Image;
function Match_Names
(Tree : in Syntax_Trees.Tree;
Tokens : in Syntax_Trees.Recover_Token_Array;
Start_Index : in SAL.Base_Peek_Type;
End_Index : in SAL.Base_Peek_Type;
End_Optional : in Boolean)
return Syntax_Trees.In_Parse_Actions.Status
is
use all type SAL.Base_Peek_Type;
use Syntax_Trees;
begin
if (Start_Index > 0 and then Tree.Contains_Virtual_Terminal (Tokens (Start_Index))) or
(End_Index > 0 and then Tree.Contains_Virtual_Terminal (Tokens (End_Index)))
then
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
end if;
declare
Start_Name_Region : constant Buffer_Region :=
(if Start_Index > 0 then Tree.Name (Tokens (Start_Index)) else Null_Buffer_Region);
End_Name_Region : constant Buffer_Region :=
(if End_Index > 0 then Tree.Name (Tokens (End_Index)) else Null_Buffer_Region);
function Equal return Boolean
is
use Ada.Characters.Handling;
Start_Name : constant String :=
(if Tree.Lexer.Descriptor.Case_Insensitive
then To_Lower (Tree.Lexer.Buffer_Text (Start_Name_Region))
else Tree.Lexer.Buffer_Text (Start_Name_Region));
End_Name : constant String :=
(if Tree.Lexer.Descriptor.Case_Insensitive
then To_Lower (Tree.Lexer.Buffer_Text (End_Name_Region))
else Tree.Lexer.Buffer_Text (End_Name_Region));
begin
return Start_Name = End_Name;
end Equal;
begin
if End_Optional then
if End_Name_Region = Null_Buffer_Region then
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
elsif Start_Name_Region = Null_Buffer_Region then
return (Syntax_Trees.In_Parse_Actions.Extra_Name_Error, Start_Index, End_Index);
else
if Equal then
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
else
return (Syntax_Trees.In_Parse_Actions.Match_Names_Error, Start_Index, End_Index);
end if;
end if;
else
if Start_Name_Region = Null_Buffer_Region then
if End_Name_Region = Null_Buffer_Region then
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
else
return (Syntax_Trees.In_Parse_Actions.Extra_Name_Error, Start_Index, End_Index);
end if;
elsif End_Name_Region = Null_Buffer_Region then
return (Syntax_Trees.In_Parse_Actions.Missing_Name_Error, Start_Index, End_Index);
else
if Equal then
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
else
return (Syntax_Trees.In_Parse_Actions.Match_Names_Error, Start_Index, End_Index);
end if;
end if;
end if;
end;
end Match_Names;
function Propagate_Name
(Tree : in Syntax_Trees.Tree;
Nonterm : in out Syntax_Trees.Recover_Token;
Tokens : in Syntax_Trees.Recover_Token_Array;
Name_Index : in Positive_Index_Type)
return Syntax_Trees.In_Parse_Actions.Status
is begin
Tree.Set_Name (Nonterm, Tree.Name (Tokens (Name_Index)));
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
end Propagate_Name;
function Merge_Names
(Tree : in Syntax_Trees.Tree;
Nonterm : in out Syntax_Trees.Recover_Token;
Tokens : in Syntax_Trees.Recover_Token_Array;
First_Index : in Positive_Index_Type;
Last_Index : in Positive_Index_Type)
return Syntax_Trees.In_Parse_Actions.Status
is begin
Tree.Set_Name (Nonterm, Tree.Name (Tokens (First_Index)) and Tree.Name (Tokens (Last_Index)));
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
end Merge_Names;
function Terminate_Partial_Parse
(Tree : in Syntax_Trees.Tree;
Partial_Parse_Active : in Boolean;
Partial_Parse_Byte_Goal : in Buffer_Pos;
Recover_Active : in Boolean;
Nonterm : in Syntax_Trees.Recover_Token)
return Syntax_Trees.In_Parse_Actions.Status
is begin
if Partial_Parse_Active and then
(not Recover_Active) and then
Tree.Byte_Region (Nonterm).Last >= Partial_Parse_Byte_Goal
then
raise WisiToken.Partial_Parse;
else
return (Label => Syntax_Trees.In_Parse_Actions.Ok);
end if;
end Terminate_Partial_Parse;
end WisiToken.In_Parse_Actions;
|