1--  EDIF printer.
2--  Copyright (C) 2019 Tristan Gingold
3--
4--  This program is free software: you can redistribute it and/or modify
5--  it under the terms of the GNU General Public License as published by
6--  the Free Software Foundation, either version 2 of the License, or
7--  (at your option) any later version.
8--
9--  This program is distributed in the hope that it will be useful,
10--  but WITHOUT ANY WARRANTY; without even the implied warranty of
11--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12--  GNU General Public License for more details.
13--
14--  You should have received a copy of the GNU General Public License
15--  along with this program.  If not, see <gnu.org/licenses>.
16
17with Ada.Text_IO; use Ada.Text_IO;
18with Types; use Types;
19with Str_Table;
20with Name_Table;
21
22package body Edif.Disp_Edif is
23   procedure Disp (N : Node; Indent : Natural);
24
25   procedure Disp_Int32 (V : Int32)
26   is
27      S : constant String := Int32'Image (V);
28   begin
29      if S (1) = ' ' then
30         Put (S (2 .. S'Last));
31      else
32         Put (S);
33      end if;
34   end Disp_Int32;
35
36   procedure Disp_Symbol (S : Name_Id)
37   is
38      Img : constant String := Name_Table.Image (S);
39   begin
40      if Img (Img'First) not in 'a' .. 'z' then
41         Put ('&');
42      end if;
43      Put (Img);
44   end Disp_Symbol;
45
46   procedure Disp_Indent (Indent : Natural) is
47   begin
48      Put ((1 .. 2 * Indent => ' '));
49   end Disp_Indent;
50
51   procedure Disp_Chain (Chain : Node; Indent : Natural)
52   is
53      N : Node;
54   begin
55      N := Chain;
56      while N /= Null_Node loop
57         Disp (N, Indent);
58         N := Get_Chain (N);
59      end loop;
60   end Disp_Chain;
61
62   procedure Disp_Keyword_Head (Name : String; Indent : Natural) is
63   begin
64      Disp_Indent (Indent);
65      Put ('(');
66      Put (Name);
67      Put (' ');
68   end Disp_Keyword_Head;
69
70   procedure Disp_Keyword_Tail is
71   begin
72      Put (')');
73      New_Line;
74   end Disp_Keyword_Tail;
75
76   procedure Disp_Keyword (Name : String; Arg : Int32; Indent : Natural) is
77   begin
78      Disp_Keyword_Head (Name, Indent);
79      Disp_Int32 (Arg);
80      Disp_Keyword_Tail;
81   end Disp_Keyword;
82
83   procedure Disp_Keyword (Name : String; Arg : Node; Indent : Natural) is
84   begin
85      Disp_Keyword_Head (Name, Indent);
86      Disp (Arg, Indent + 1);
87      Disp_Keyword_Tail;
88   end Disp_Keyword;
89
90   procedure Disp_Keyword (Name : String; Arg : Name_Id; Indent : Natural) is
91   begin
92      Disp_Keyword_Head (Name, Indent);
93      Disp_Symbol (Arg);
94      Disp_Keyword_Tail;
95   end Disp_Keyword;
96
97   procedure Disp_Decl_Head (Name : String; N : Node; Indent : Natural) is
98   begin
99      Disp_Keyword_Head (Name, Indent);
100      Disp (Get_Name (N), Indent);
101      New_Line;
102   end Disp_Decl_Head;
103
104   procedure Disp_Decl_Tail (Indent : Natural) is
105   begin
106      Disp_Indent (Indent);
107      Disp_Keyword_Tail;
108   end Disp_Decl_Tail;
109
110   procedure Disp_Opt (N : Node; Indent : Natural) is
111   begin
112      if N /= Null_Node then
113         Disp (N, Indent);
114      end if;
115   end Disp_Opt;
116
117   procedure Disp (N : Node; Indent : Natural) is
118   begin
119      if N = Null_Node then
120         Put ("()");
121         return;
122      end if;
123
124      case Get_Kind (N) is
125         when N_Keyword =>
126            declare
127               El : Node;
128            begin
129               New_Line;
130               Disp_Indent (Indent);
131               Put ('(');
132               Put (Name_Table.Image (Get_Keyword (N)));
133               El := Get_CDR (N);
134               while El /= Null_Node loop
135                  Put (' ');
136                  Disp (Get_CAR (El), Indent + 1);
137                  El := Get_CDR (El);
138               end loop;
139               Put (')');
140            end;
141
142         when N_Symbol =>
143            Disp_Symbol (Get_Symbol (N));
144
145         when N_Number =>
146            Disp_Int32 (Get_Number (N));
147
148         when N_String =>
149            Put ('"');
150            Put (Str_Table.String_String8
151                   (Get_String_Id (N), Nat32 (Get_String_Len (N))));
152            Put ('"');
153
154         when N_Edif =>
155            Disp_Decl_Head ("edif", N, Indent);
156            Disp_Keyword ("edifversion", Get_Edif_Version (N), Indent + 1);
157            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
158            Disp_Keyword ("keywordmap", Get_Keyword_Map (N), Indent + 1);
159            Disp_Keyword ("status", Get_Status (N), Indent + 1);
160            Disp_Chain (Get_External_Chain (N), Indent + 1);
161            Disp_Chain (Get_Library_Chain (N), Indent + 1);
162            Disp (Get_Design (N), Indent + 1);
163            Disp_Decl_Tail (Indent);
164
165         when N_Library =>
166            Disp_Decl_Head ("library", N, Indent);
167            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
168            Disp_Keyword ("technology", Get_Technology (N), Indent + 1);
169            Disp_Chain (Get_Cells_Chain (N), Indent + 1);
170            Disp_Decl_Tail (Indent);
171
172         when N_External =>
173            Disp_Decl_Head ("external", N, Indent);
174            Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1);
175            Disp_Keyword ("technology", Get_Technology (N), Indent + 1);
176            Disp_Chain (Get_Cells_Chain (N), Indent + 1);
177            Disp_Decl_Tail (Indent);
178
179         when N_Cell =>
180            Disp_Decl_Head ("cell", N, Indent);
181            Disp_Keyword ("celltype", Get_Cell_Type (N), Indent + 1);
182            Disp (Get_View (N), Indent + 1);
183            Disp_Decl_Tail (Indent);
184
185         when N_View =>
186            Disp_Decl_Head ("view", N, Indent);
187            Disp_Keyword ("viewtype", Get_View_Type (N), Indent + 1);
188            Disp (Get_Interface (N), Indent + 1);
189            declare
190               Contents : constant Node := Get_Contents_Chain (N);
191            begin
192               if Contents /= Null_Node then
193                  Disp_Keyword_Head ("contents", Indent + 1);
194                  New_Line;
195                  Disp_Chain (Contents, Indent + 2);
196                  Disp_Indent (Indent + 1);
197                  Disp_Keyword_Tail;
198               end if;
199            end;
200            Disp_Decl_Tail (Indent);
201
202         when N_Interface =>
203            Disp_Keyword_Head ("interface", Indent);
204            New_Line;
205            Disp_Chain (Get_Ports_Chain (N), Indent + 1);
206            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
207            Disp_Indent (Indent);
208            Disp_Keyword_Tail;
209
210         when N_Port =>
211            Disp_Decl_Head ("port", N, Indent);
212            Disp_Keyword_Head ("direction", Indent + 1);
213            case Get_Direction (N) is
214               when Dir_Input =>
215                  Put ("input");
216               when Dir_Output =>
217                  Put ("output");
218               when Dir_Inout =>
219                  Put ("inout");
220            end case;
221            Disp_Keyword_Tail;
222            Disp_Decl_Tail (Indent);
223
224         when N_Rename =>
225            Put ("(rename ");
226            Disp (Get_Name (N), Indent);
227            Put (' ');
228            Disp (Get_String (N), Indent);
229            Put (')');
230
231         when N_Member =>
232            Put ("(member ");
233            Disp (Get_Name (N), Indent);
234            Put (' ');
235            Disp_Int32 (Get_Index (N));
236            Put (')');
237
238         when N_Array =>
239            Put ("(array ");
240            Disp (Get_Name (N), Indent);
241            Put (' ');
242            Disp_Int32 (Get_Array_Length (N));
243            Put (')');
244
245         when N_Instance =>
246            Disp_Decl_Head ("instance", N, Indent);
247            Disp (Get_Instance_Ref (N), Indent + 1);
248            Disp_Chain (Get_Port_Instances_Chain (N), Indent + 1);
249            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
250            Disp_Decl_Tail (Indent);
251
252         when N_Net =>
253            Disp_Decl_Head ("net", N, Indent);
254            Disp_Chain (Get_Joined_Chain (N), Indent + 1);
255            Disp_Decl_Tail (Indent);
256
257         when N_View_Ref =>
258            Disp_Decl_Head ("viewref", N, Indent);
259            Disp (Get_Cell_Ref (N), Indent + 1);
260            Disp_Decl_Tail (Indent);
261
262         when N_Cell_Ref =>
263            Disp_Keyword_Head ("cellref", Indent);
264            Disp (Get_Name (N), Indent);
265            Disp_Opt (Get_Library_Ref (N), Indent + 1);
266            Disp_Keyword_Tail;
267
268         when N_Port_Ref =>
269            Disp_Keyword_Head ("portref", Indent);
270            Disp (Get_Port (N), Indent);
271            Disp_Opt (Get_Instance_Ref (N), Indent + 1);
272            Disp_Keyword_Tail;
273
274         when N_Property =>
275            Disp_Keyword_Head ("property", Indent);
276            Disp (Get_Name (N), Indent);
277            Put (' ');
278            Disp (Get_Value (N), Indent);
279            Disp_Keyword_Tail;
280
281         when N_Port_Instance =>
282            Disp_Decl_Head ("portinstance", N, Indent);
283            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
284            Disp_Decl_Tail (Indent);
285
286         when N_Design =>
287            Disp_Decl_Head ("design", N, Indent);
288            Disp (Get_Cell_Ref (N), Indent + 1);
289            Disp_Chain (Get_Properties_Chain (N), Indent + 1);
290            Disp_Decl_Tail (Indent);
291
292         when N_Boolean =>
293            if Get_Boolean (N) then
294               Put ("(true)");
295            else
296               Put ("(false)");
297            end if;
298
299         when others =>
300            Put ("??? " & Nkind'Image (Get_Kind (N)));
301      end case;
302   end Disp;
303
304   procedure Disp_Node (N : Node) is
305   begin
306      Disp (N, 0);
307   end Disp_Node;
308end Edif.Disp_Edif;
309