source: trunk/ada-2012/tools/ag/ag_driver.adb@ 385

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

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