source: branches/invoke/tools/ag/ag_driver.adb@ 254

Last change on this file since 254 was 254, checked in by Maxim Reznik, 6 years ago

Implement First/Last Token

File size: 9.2 KB
Line 
1------------------------------------------------------------------------------
2-- G E L A G R A M M A R S --
3-- Library for dealing with grammars for Gela project, --
4-- a portable Ada compiler --
5-- http://gela.ada-ru.org/ --
6-- - - - - - - - - - - - - - - - --
7-- Read copyright and license in gela.ads file --
8------------------------------------------------------------------------------
9
10with Ada.Command_Line;
11with Ada.Text_IO;
12
13with League.Strings;
14
15with Gela.Grammars;
16
17with AG_Tools; use AG_Tools;
18with AG_Tools.Writers; use AG_Tools.Writers;
19-- with Gela.Grammars_Debug;
20with AG_Tools.Input;
21with AG_Tools.Element_Generators;
22
23procedure AG_Driver is
24 use AG_Tools.Input;
25
26 use type Gela.Grammars.Production_Index;
27 use type Gela.Grammars.Part_Count;
28 use type Gela.Grammars.Non_Terminal_Count;
29 use type League.Strings.Universal_String;
30
31 procedure Generate_Visiter;
32 procedure Generate_2;
33
34 Name : constant String := Ada.Command_Line.Argument (1);
35 G : Gela.Grammars.Grammar_Access;
36
37 procedure Generate_2 is
38 Fab_With : Writer;
39 Fab_Kind : Writer;
40 Fab_When : Writer;
41 Factories : Writer;
42 Impl : Writer;
43 Conv : Writer;
44 begin
45 Factories.P ("with Gela.Lexical_Types;");
46 Factories.P ("with Gela.Elements;");
47 Factories.P;
48 Factories.P ("package Gela.LARL_Parsers_Nodes is");
49 Impl.P ("package body Gela.LARL_Parsers_Nodes is");
50 Factories.P (" pragma Preelaborate;");
51 Factories.P;
52 Factories.P (" type Node is private;");
53 Factories.P (" type Node_Array is array (Positive range <>) of Node;");
54 Factories.P;
55 Factories.P (" None : constant Node;");
56 Factories.P (" No_Token : constant Node;");
57 Factories.P;
58 Factories.P (" No_Token_Index : constant " &
59 "Gela.Lexical_Types.Token_Count := 0;");
60 Factories.P;
61
62 Factories.N (" function ""-"" (X : Node) return " &
63 "Gela.Elements.Element_Sequence_Access", Conv);
64 Factories.P (";");
65 Factories.P;
66 Conv.P (" is");
67 Conv.P (" begin");
68 Conv.P (" case X.Kind is");
69
70 Factories.N (" function ""-"" (X : Node)" &
71 " return Gela.Lexical_Types.Token_Count", Impl);
72 Factories.P (";");
73 Impl.P (" is");
74 Impl.P (" begin");
75 Impl.P (" return X.Token;");
76 Impl.P (" end ""-"";");
77 Impl.P;
78
79 Factories.N (" function ""-"" (X : Node)" &
80 " return access Gela.Elements.Element'Class", Impl);
81 Factories.P (";");
82 Impl.P (" is");
83 Impl.P (" begin");
84 Impl.P (" return X.Element;");
85 Impl.P (" end ""-"";");
86 Impl.P;
87
88 Factories.N (" function ""+"" (X : Gela.Lexical_Types.Token_Count)" &
89 " return Node", Impl);
90 Factories.P (";");
91 Impl.P (" is");
92 Impl.P (" begin");
93 Impl.P (" return (Token, X);");
94 Impl.P (" end ""+"";");
95 Impl.P;
96
97 Factories.N
98 (" function ""+"" (X : access Gela.Elements.Element'Class)" &
99 " return Node", Impl);
100 Factories.P (";");
101 Impl.P (" is");
102 Impl.P (" begin");
103 Impl.P (" return (Element, X);");
104 Impl.P (" end ""+"";");
105 Impl.P;
106
107 Fab_Kind.P (" type Node_Kinds is");
108 Fab_Kind.P (" (Token,");
109 Fab_Kind.N (" Element");
110
111 for NT of G.Non_Terminal loop
112 if not NT.Is_List then
113 if Has_List (NT.Index) then
114 Fab_With.N ("with Gela.Elements.");
115 Fab_With.N (To_Ada (Plural (NT.Name)));
116 Fab_With.P (";");
117
118 Fab_Kind.P (",");
119 Fab_Kind.N (" ");
120 Fab_Kind.N (To_Ada (NT.Name));
121 Fab_Kind.N ("_Sequence");
122
123 Factories.P (" function ""-"" (X : Node) return", Impl);
124 Factories.N (" Gela.Elements.", Impl);
125 Factories.N (To_Ada (Plural (NT.Name)), Impl);
126 Factories.N (".", Impl);
127 Factories.N (To_Ada (NT.Name), Impl);
128 Factories.N ("_Sequence_Access", Impl);
129 Factories.P (";");
130 Impl.P (" is");
131 Impl.P (" begin");
132 Impl.N (" return X.");
133 Impl.N (To_Ada (NT.Name));
134 Impl.P ("_Sequence;");
135 Impl.P (" end ""-"";");
136 Impl.P;
137
138 Factories.P (" function ""+""", Impl);
139 Factories.N (" (X : Gela.Elements.", Impl);
140 Factories.N (To_Ada (Plural (NT.Name)), Impl);
141 Factories.N (".", Impl);
142 Factories.N (To_Ada (NT.Name), Impl);
143 Factories.P ("_Sequence_Access)", Impl);
144 Factories.N (" return Node", Impl);
145 Factories.P (";");
146 Impl.P (" is");
147 Impl.P (" begin");
148 Impl.N (" return (");
149 Impl.N (To_Ada (NT.Name));
150 Impl.P ("_Sequence, X);");
151 Impl.P (" end ""+"";");
152 Impl.P;
153
154 Fab_When.N (" when ");
155 Fab_When.N (To_Ada (NT.Name));
156 Fab_When.P ("_Sequence =>");
157 Fab_When.N (" ");
158 Fab_When.N (To_Ada (NT.Name));
159 Fab_When.P ("_Sequence :");
160 Fab_When.N (" Gela.Elements.");
161 Fab_When.N (To_Ada (Plural (NT.Name)));
162 Fab_When.N (".");
163 Fab_When.N (To_Ada (NT.Name));
164 Fab_When.P ("_Sequence_Access;");
165
166 Conv.N (" when ");
167 Conv.N (To_Ada (NT.Name));
168 Conv.P ("_Sequence =>");
169 Conv.P
170 (" return Gela.Elements.Element_Sequence_Access");
171 Conv.N (" (X.");
172 Conv.N (To_Ada (NT.Name));
173 Conv.P ("_Sequence);");
174 end if;
175 end if;
176 end loop;
177
178 Conv.P (" when others =>");
179 Conv.P (" raise Constraint_Error;");
180 Conv.P (" end case;");
181 Conv.P (" end ""-"";");
182
183 Factories.P;
184 Factories.P ("private");
185 Factories.P;
186 Factories.N (Fab_Kind.Text);
187 Factories.P (");");
188 Factories.P;
189 Factories.P (" type Node (Kind : Node_Kinds := Token) is record");
190 Factories.P (" case Kind is");
191 Factories.P (" when Token =>");
192 Factories.P (" Token : Gela.Lexical_Types.Token_Count;");
193 Factories.P (" when Element =>");
194 Factories.P (" Element : Gela.Elements.Element_Access;");
195
196 Ada.Text_IO.Put_Line (Fab_With.Text.To_UTF_8_String);
197 Ada.Text_IO.Put_Line (Factories.Text.To_UTF_8_String);
198 Ada.Text_IO.Put_Line (Fab_When.Text.To_UTF_8_String);
199 Factories.Clear;
200
201 Factories.P (" end case;");
202 Factories.P (" end record;");
203 Factories.P;
204 Factories.P (" None : constant Node := (Element, null);");
205 Factories.P (" No_Token : constant Node := (Token, 0);");
206 Factories.P;
207 Factories.N ("end Gela.LARL_Parsers_Nodes;", Conv);
208
209 Ada.Text_IO.Put_Line (Factories.Text.To_UTF_8_String);
210 Ada.Text_IO.Put_Line (Impl.Text.To_UTF_8_String);
211 Ada.Text_IO.Put_Line (Conv.Text.To_UTF_8_String);
212 end Generate_2;
213
214 ----------------------
215 -- Generate_Visiter --
216 ----------------------
217
218 procedure Generate_Visiter is
219 Withes : Writer;
220 Spec : Writer;
221 Name : League.Strings.Universal_String;
222 begin
223 Spec.P ("package Gela.Element_Visiters is");
224 Spec.P (" pragma Preelaborate;");
225 Spec.P;
226 Spec.P (" type Visiter is limited interface;");
227 Spec.P (" type Visiter_Access is access all Visiter'Class;");
228
229 for NT of G.Non_Terminal loop
230 for Prod of G.Production (NT.First .. NT.Last) loop
231 if Is_Concrete (NT.Index) and not NT.Is_List then
232 Name := To_Ada (NT.Name);
233 Withes.N ("with Gela.Elements.");
234 Withes.N (Plural (Name));
235 Withes.P (";");
236 Spec.P;
237 Spec.N (" not overriding procedure ");
238 Spec.P (To_Ada (Name));
239 Spec.P (" (Self : in out Visiter;");
240 Spec.N (" Node : not null Gela.Elements.");
241 Spec.N (Plural (Name));
242 Spec.N (".");
243 Spec.N (To_Ada (Name));
244 Spec.P ("_Access)");
245 Spec.P (" is null;");
246 end if;
247 end loop;
248 end loop;
249
250 Spec.P;
251 Spec.P ("end Gela.Element_Visiters;");
252 Ada.Text_IO.Put_Line (Withes.Text.To_UTF_8_String);
253 Ada.Text_IO.Put_Line (Spec.Text.To_UTF_8_String);
254 end Generate_Visiter;
255
256begin
257 AG_Tools.Input.Initialize (Name);
258 G := AG_Tools.Input.Grammar;
259
260-- Gela.Grammars_Debug.Print (G);
261
262-- Generate_Factory;
263 Generate_2;
264 Generate_Visiter;
265 AG_Tools.Element_Generators.Generate_Elements (G);
266 AG_Tools.Element_Generators.Generate_Factory (G);
267end AG_Driver;
Note: See TracBrowser for help on using the repository browser.