Skip to content

Commit 2e2a295

Browse files
reznikmmreznikmm
committed
Make LSP_Gen create trivial message loggers
We can use them to derive customized loggers. Refs #1170
1 parent 39c8799 commit 2e2a295

File tree

3 files changed

+453
-0
lines changed

3 files changed

+453
-0
lines changed

‎source/lsp_gen/lsp_gen-notifications.adb‎

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,10 @@ package body LSP_Gen.Notifications is
3737
(Model : LSP_Gen.Meta_Models.Meta_Model;
3838
From : LSP_Gen.Configurations.Message_Direction);
3939

40+
procedure Write_Loggers
41+
(Model : LSP_Gen.Meta_Models.Meta_Model;
42+
From : LSP_Gen.Configurations.Message_Direction);
43+
4044
procedure Write_Notification_Types
4145
(Model : LSP_Gen.Meta_Models.Meta_Model;
4246
From : LSP_Gen.Configurations.Message_Direction);
@@ -50,6 +54,131 @@ package body LSP_Gen.Notifications is
5054
when LSP_Gen.Configurations.From_Client => "Server",
5155
when LSP_Gen.Configurations.From_Server => "Client"));
5256

57+
-------------------
58+
-- Write_Loggers --
59+
-------------------
60+
61+
procedure Write_Loggers
62+
(Model : LSP_Gen.Meta_Models.Meta_Model;
63+
From : LSP_Gen.Configurations.Message_Direction)
64+
is
65+
use all type LSP_Gen.Configurations.Message_Direction;
66+
67+
Kind : constant VSS.Strings.Virtual_String := Prefix (From);
68+
Name : constant VSS.Strings.Virtual_String :=
69+
Kind & "_Notification_Logger";
70+
begin
71+
Put_Lines (Model.License_Header, "-- ");
72+
New_Line;
73+
74+
if From = From_Both then
75+
Put_Line ("with VSS.Text_Streams;");
76+
else
77+
Put_Line ("with LSP.Base_Notification_Loggers;");
78+
end if;
79+
80+
Put_Line ("with LSP.Structures;");
81+
Put ("with LSP.");
82+
Put (Kind);
83+
Put_Line ("_Notification_Receivers;");
84+
New_Line;
85+
Put ("package LSP.");
86+
Put (Name);
87+
Put_Line ("s is");
88+
Put_Line ("pragma Preelaborate;");
89+
New_Line;
90+
Put ("type ");
91+
Put_Line (Name);
92+
93+
if From = From_Both then
94+
Put ("(Output : access VSS.Text_Streams");
95+
Put_Line (".Output_Text_Stream'Class)");
96+
Put ("is new ");
97+
else
98+
Put ("is new LSP.Base_Notification_Loggers.Base_Notification_Logger");
99+
Put (" and ");
100+
end if;
101+
102+
Put ("LSP.");
103+
Put (Kind);
104+
Put ("_Notification_Receivers.");
105+
Put (Kind);
106+
Put_Line ("_Notification_Receiver");
107+
Put_Line ("with null record;");
108+
New_Line;
109+
110+
for J of Model.Notifications loop
111+
if Model.Message_Direction (J) = From then
112+
Put ("overriding procedure On_");
113+
Put (Model.Message_Name (J));
114+
Put_Line ("_Notification");
115+
Put ("(Self : in out ");
116+
Put (Name);
117+
118+
if Model.Notification (J).params.Is_Set then
119+
Put_Line (";");
120+
Put ("Value : LSP.Structures.");
121+
Put (Model.Notification (J).params.Value.Union.reference.name);
122+
end if;
123+
124+
Put_Line (");");
125+
New_Line;
126+
end if;
127+
end loop;
128+
129+
Put_Line ("end;");
130+
131+
New_Line;
132+
Put_Lines (Model.License_Header, "-- ");
133+
New_Line;
134+
135+
Put_Line ("with VSS.Strings;");
136+
New_Line;
137+
138+
Put ("package body LSP.");
139+
Put (Name);
140+
Put_Line ("s is");
141+
New_Line;
142+
143+
for J of Model.Notifications loop
144+
if Model.Message_Direction (J) = From then
145+
Put ("overriding procedure On_");
146+
Put (Model.Message_Name (J));
147+
Put_Line ("_Notification");
148+
Put ("(Self : in out ");
149+
Put (Name);
150+
151+
if Model.Notification (J).params.Is_Set then
152+
Put_Line (";");
153+
Put ("Value : LSP.Structures.");
154+
Put (Model.Notification (J).params.Value.Union.reference.name);
155+
end if;
156+
157+
Put_Line (")");
158+
Put_Line ("is");
159+
Put_Line ("Ok : Boolean := False;");
160+
Put_Line ("begin");
161+
Put ("Self.Output.Put (""'");
162+
Put (J);
163+
Put_Line ("'"", Ok);");
164+
165+
if Model.Notification (J).params.Is_Set then
166+
Put_Line ("Self.Output.Put ("" Params : "", Ok);");
167+
168+
Put ("Self.Output.Put (VSS.Strings.To_Virtual_String");
169+
Put_Line (" (Value'Wide_Wide_Image), Ok);");
170+
end if;
171+
172+
Put ("Self.Output.New_Line (Ok);");
173+
Put_Line ("end;");
174+
New_Line;
175+
end if;
176+
end loop;
177+
178+
Put_Line ("end;");
179+
180+
end Write_Loggers;
181+
53182
------------------------------
54183
-- Write_Notification_Types --
55184
------------------------------
@@ -372,6 +501,9 @@ package body LSP_Gen.Notifications is
372501
Write_Receivers (Model, From_Server);
373502
Write_Notification_Types (Model, From_Client);
374503
Write_Notification_Types (Model, From_Server);
504+
Write_Loggers (Model, From_Server);
505+
Write_Loggers (Model, From_Client);
506+
Write_Loggers (Model, From_Both);
375507
end Write;
376508

377509
-------------------

‎source/lsp_gen/lsp_gen-requests.adb‎

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,10 @@ package body LSP_Gen.Requests is
3939
(Model : LSP_Gen.Meta_Models.Meta_Model;
4040
From : LSP_Gen.Configurations.Message_Direction);
4141

42+
procedure Write_Loggers
43+
(Model : LSP_Gen.Meta_Models.Meta_Model;
44+
From : LSP_Gen.Configurations.Message_Direction);
45+
4246
function Prefix
4347
(From : LSP_Gen.Configurations.Message_Direction)
4448
return VSS.Strings.Virtual_String is
@@ -48,6 +52,150 @@ package body LSP_Gen.Requests is
4852
when LSP_Gen.Configurations.From_Client => "Server",
4953
when LSP_Gen.Configurations.From_Server => "Client"));
5054

55+
-------------------
56+
-- Write_Loggers --
57+
-------------------
58+
59+
procedure Write_Loggers
60+
(Model : LSP_Gen.Meta_Models.Meta_Model;
61+
From : LSP_Gen.Configurations.Message_Direction)
62+
is
63+
use all type LSP_Gen.Configurations.Message_Direction;
64+
65+
Kind : constant VSS.Strings.Virtual_String := Prefix (From);
66+
Name : constant VSS.Strings.Virtual_String :=
67+
Kind & "_Request_Logger";
68+
begin
69+
Put_Lines (Model.License_Header, "-- ");
70+
New_Line;
71+
Put_Line ("with LSP.Structures;");
72+
Put_Line ("with VSS.Text_Streams;");
73+
Put ("with LSP.");
74+
Put (Kind);
75+
Put_Line ("_Request_Receivers;");
76+
New_Line;
77+
Put ("package LSP.");
78+
Put (Name);
79+
Put_Line ("s is");
80+
Put_Line ("pragma Preelaborate;");
81+
New_Line;
82+
Put ("type ");
83+
Put_Line (Name);
84+
85+
Put ("(Output : access VSS.Text_Streams");
86+
Put_Line (".Output_Text_Stream'Class)");
87+
Put ("is new ");
88+
89+
Put ("LSP.");
90+
Put (Kind);
91+
Put ("_Request_Receivers.");
92+
Put (Kind);
93+
Put_Line ("_Request_Receiver");
94+
Put_Line ("with null record;");
95+
New_Line;
96+
97+
for J of Model.Requests loop
98+
if Model.Message_Direction (J) = From then
99+
Put ("overriding procedure On_");
100+
Put (Model.Message_Name (J));
101+
Put_Line ("_Request");
102+
Put ("(Self : in out ");
103+
Put (Name);
104+
Put_Line (";");
105+
Put_Line ("Id : LSP.Structures.Integer_Or_Virtual_String");
106+
107+
if Model.Request (J).params.Is_Set then
108+
Put_Line (";");
109+
Put ("Value : LSP.Structures.");
110+
Put (Param_Type (Model, J));
111+
end if;
112+
113+
Put_Line (");");
114+
New_Line;
115+
end if;
116+
end loop;
117+
118+
Put_Line ("procedure Put_Id");
119+
Put (" (Self : in out ");
120+
Put (Name);
121+
Put_Line ("'Class;");
122+
Put_Line (" Id : LSP.Structures.Integer_Or_Virtual_String;");
123+
Put_Line (" Ok : in out Boolean);");
124+
New_Line;
125+
126+
Put_Line ("end;");
127+
128+
New_Line;
129+
Put_Lines (Model.License_Header, "-- ");
130+
131+
New_Line;
132+
Put_Line ("with VSS.Strings;");
133+
New_Line;
134+
Put ("package body LSP.");
135+
Put (Name);
136+
Put_Line ("s is");
137+
New_Line;
138+
139+
for J of Model.Requests
140+
when Model.Message_Direction (J) = From
141+
loop
142+
Put ("overriding procedure On_");
143+
Put (Model.Message_Name (J));
144+
Put_Line ("_Request");
145+
Put ("(Self : in out ");
146+
Put (Name);
147+
Put_Line (";");
148+
Put_Line ("Id : LSP.Structures.Integer_Or_Virtual_String");
149+
150+
if Model.Request (J).params.Is_Set then
151+
Put_Line (";");
152+
Put ("Value : LSP.Structures.");
153+
Put (Param_Type (Model, J));
154+
end if;
155+
156+
Put_Line (")");
157+
Put_Line ("is");
158+
Put_Line ("Ok : Boolean := False;");
159+
Put_Line ("begin");
160+
Put ("Self.Output.Put (""'");
161+
Put (J);
162+
Put_Line ("'"", Ok);");
163+
Put_Line ("Self.Put_Id (Id, Ok);");
164+
165+
if Model.Request (J).params.Is_Set then
166+
Put_Line ("Self.Output.Put ("" Params : "", Ok);");
167+
168+
Put ("Self.Output.Put (VSS.Strings.To_Virtual_String");
169+
Put_Line (" (Value'Wide_Wide_Image), Ok);");
170+
end if;
171+
172+
Put ("Self.Output.New_Line (Ok);");
173+
Put_Line ("end;");
174+
New_Line;
175+
end loop;
176+
177+
Put_Line ("procedure Put_Id");
178+
Put (" (Self : in out ");
179+
Put (Name);
180+
Put_Line ("'Class;");
181+
Put_Line ("Id : LSP.Structures.Integer_Or_Virtual_String;");
182+
Put_Line ("Ok : in out Boolean) is");
183+
Put_Line ("begin");
184+
Put_Line ("Self.Output.Put ("" Id="", Ok);");
185+
New_Line;
186+
Put_Line ("if Id.Is_Integer then");
187+
Put ("Self.Output.Put (VSS.Strings.To_Virtual_String");
188+
Put_Line (" (Id.Integer'Wide_Wide_Image), Ok);");
189+
Put_Line ("else");
190+
Put_Line ("Self.Output.Put (Id.Virtual_String, Ok);");
191+
Put_Line ("end if;");
192+
Put_Line ("end Put_Id;");
193+
New_Line;
194+
195+
Put_Line ("end;");
196+
197+
end Write_Loggers;
198+
51199
------------------------------
52200
-- Write_Request_Types --
53201
------------------------------
@@ -369,6 +517,8 @@ package body LSP_Gen.Requests is
369517
Write_Receivers (Model, From_Server);
370518
Write_Request_Types (Model, From_Client);
371519
Write_Request_Types (Model, From_Server);
520+
Write_Loggers (Model, From_Server);
521+
Write_Loggers (Model, From_Client);
372522
end Write;
373523

374524
-------------------

0 commit comments

Comments
 (0)