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 |
|
---|
10 | with Ada.Command_Line;
|
---|
11 | with Ada.Text_IO;
|
---|
12 |
|
---|
13 | with League.Strings;
|
---|
14 |
|
---|
15 | with Gela.Grammars;
|
---|
16 |
|
---|
17 | with AG_Tools; use AG_Tools;
|
---|
18 | with AG_Tools.Writers; use AG_Tools.Writers;
|
---|
19 | -- with Gela.Grammars_Debug;
|
---|
20 | with AG_Tools.Input;
|
---|
21 | with AG_Tools.Element_Generators;
|
---|
22 | with AG_Tools.Prop_Visiters;
|
---|
23 |
|
---|
24 | procedure 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 |
|
---|
257 | begin
|
---|
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);
|
---|
269 | end AG_Driver;
|
---|