1----------------------------------------------------------------------------
2--      get_entities (get_entities.adb)
3--
4--               Copyright (C) 2013, Brian Drummond
5--
6--      This file is part of the ghdl-updates project.
7--
8--      get_entities is free software: you can redistribute it and/or modify
9--      it under the terms of the GNU General Public License as published by
10--      the Free Software Foundation, either version 2 of the License, or
11--      (at your option) any later version.
12--
13--      get_entities is distributed in the hope that it will be useful,
14--      but WITHOUT ANY WARRANTY; without even the implied warranty of
15--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16--      GNU General Public License for more details.
17--
18--      You should have received a copy of the GNU General Public License
19--      along with get_entities.  If not, see <http://www.gnu.org/licenses/>.
20----------------------------------------------------------------------------
21
22with Ada.Text_Io; use Ada.Text_IO;
23with Ada.Characters.Handling;
24with Ada.Strings.Fixed;
25with Ada.Strings.Maps;
26with Ada.Strings.Unbounded;
27with Ada.Directories;
28with Ada.Command_Line;
29
30procedure get_entities is
31
32   function Valid_Test(Name : in String) return boolean is
33      use Ada.Directories;
34      use Ada.Characters.Handling;
35   begin
36      return Extension(To_Lower(Name)) = "vhd"
37        or Extension(To_Lower(Name)) = "vhdl";
38   end Valid_Test;
39
40   procedure Get_Top_Entities(Test_Name : in String) is
41      use Ada.Text_Io;
42      use Ada.Strings.Fixed;
43      use Ada.Characters.Handling;
44      use Ada.Strings.Unbounded;
45
46      File : File_Type;
47
48      function Get_End(Line : in String) return Natural is
49         Comment : natural := Index(Line,"--");
50      begin
51         if Comment = 0 then
52            return Line'last;
53         else
54            return Comment - 1;
55         end if;
56      end Get_End;
57
58      type State_Type is (Idle, Have_Entity, Have_Name, In_Entity);
59      State : State_Type;
60
61      Top_Level_Entity : Boolean;
62      Name : Unbounded_String;
63
64      Last_Entity : Unbounded_String;
65   begin
66   -- Return the name of all top-level entities in the file.
67   -- Report on stderr, a malformed one
68   -- "malformed" means not conforming to the expectations of this simple parser.
69   -- A top level entity has the form
70   -- Entity <name> is
71   -- <no port clause>
72   -- end {entity} <name>
73
74      Open(File, In_File, Test_Name);
75      State := Idle;
76      loop
77         declare
78            -- strip name of blanks etc...
79            CharSet       : constant Ada.Strings.Maps.Character_Ranges := (('A','Z'), ('a','z'), ('0','9'), ('_','_'));
80
81            function Token(Source, Name : String; From : positive := 1) return natural is
82               use Ada.Strings.Maps;
83               Pos : natural := Index(Source, Name, From => From);
84            begin
85               -- Look in Source for Name, either surrounded by whitespace or at the start or end of a line
86               if Pos = 0 or Pos = 1 or Pos + Name'Length > Source'Length then
87                  return Pos;
88               elsif not is_in (Source(Pos - 1), To_Set(CharSet)) and
89                     not is_in (Source(Pos + Name'Length), To_Set(CharSet)) then
90                  return Pos;
91               else
92                  return 0;
93               end if;
94            end Token;
95
96            function  Strip_Quoted(Raw : String) return String is
97               temp : String(Raw'range);
98               t    : natural := Raw'first;
99               copy : Boolean := true;
100            begin
101               -- Eliminate quoted text
102               for i in Raw'range loop
103                  if copy then
104                     if Raw(i) = '"' then
105                        copy := not copy;
106                     else
107                        temp(t) := Raw(i);
108                        t := t + 1;
109                     end if;
110                  else
111                     if Raw(i) = '"' then
112                        copy := not copy;
113                     end if;
114                  end if;
115               end loop;
116               if t > Raw'last then t := Raw'last; end if;
117               return temp(Raw'first .. t);
118            end Strip_Quoted;
119
120	    Line    : String  := Get_Line (File); -- line based to strip off comments
121            EndLine : natural := Get_End (Line);
122            Raw     : String  := To_Lower(Line (1 .. EndLine));
123            Code    : String  := Strip_Quoted(Raw);
124            -- positions of specific strings in a line.
125            Ent     : Natural := Token(Code, "entity");
126            Port    : Natural := Token(Code, "port");
127            End_Pos : Natural := Token(Code, "end");
128            I       : Natural;  -- position of "is" in current line
129            Name_s  : Natural;	-- start of a possible entity name
130            Name_e  : Natural;  -- end of a possible entity name
131            Name_n  : Natural;  -- start of next name (should be "is")
132            Dot     : Natural;  -- position of "." indicating qualified name, e.g. entity instantiation
133
134            procedure Get_Name is
135            begin
136               Name_e := Index(Code, Ada.Strings.Maps.To_Set(CharSet),
137                                        Test => Ada.Strings.Outside, From => Name_s);
138               if Name_e = 0 then Name_e := Code'last; end if;
139               --Put_Line("Name : " & To_S(Name) & " "
140               --           & natural'image(Name_s) & " " & natural'image(Name_e)
141               --           & natural'image(Code'last));
142               if Name_e < Code'last then
143                  Name_n := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Name_e);
144               else
145                  Name_n := 0;
146               end if;
147               I := Token(Code, "is", From => Name_e);
148               Dot := Index(Code, ".", From => Name_e);
149
150               if Name_e < Name_s then
151                  Put_Line(Standard_Error, "Malformed name : " & Code);
152               end if;
153               Name := To_Unbounded_String (Code (Name_s .. Name_e-1));
154               if I = 0 then  -- "is" must be on a subsequent line
155                  State := Have_Name;
156               elsif Name_n = I then   -- next word is "is"
157                  State := In_Entity;
158               elsif Dot < Name_n and Dot >= Name_e then
159                  -- direct instantiation ... reject
160                  State := Idle;
161               elsif Name_n < I then
162                  Put_Line(Standard_Error, "Name error : file " & Test_Name);
163                  Put_Line(Standard_Error, "Entity : """ & Code(Name_s .. I-1) & """ not valid");
164                  -- raise Program_Error;
165               end if;
166            end Get_Name;
167
168         begin
169            case State is
170               when Idle =>
171                  if Ent /= 0 then
172                     -- Put_Line(Code);
173                     Top_Level_Entity := True;
174                     Name_s := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Ent + 6);
175
176                     if Name_s = 0 then -- entity name must be on a subsequent line
177                        State := Have_Entity;
178                     else
179                        Get_Name;
180                     end if;
181                  end if;
182               when Have_Entity =>
183                  Name_s := Index(Code, Ada.Strings.Maps.To_Set(CharSet), From => Ent + 6);
184                  if Name_s > 0 then
185                     Get_Name;
186                  end if;
187               when Have_Name =>
188                  if I > 0 then
189                     State := In_Entity;
190                  end if;
191               when In_Entity =>  -- wait for End, handle Port;
192                  -- NB the End may not be End Entity, but whatever it Ends, it must follow the port list
193                  -- so we may stop looking for a port list when we see it.
194                  if Port > 0 then
195                     Top_Level_Entity := False;
196                  end if;
197                  if End_Pos > 0 then
198                     if Top_Level_Entity then -- write name to stdout
199                        Last_Entity := Name;
200                     end if;
201                     State := Idle;
202                  end if;
203            end Case;
204	    exit when End_Of_File (File);
205         end;
206      end loop;
207
208      if Last_Entity /= "" then
209         Put_Line (To_String (Last_Entity));
210      end if;
211      Close(File);
212
213   end Get_Top_Entities;
214
215   procedure Usage is
216   begin
217      Put_Line(Standard_Error,
218               "Usage : " & Ada.Command_Line.Command_Name & " <filename>");
219   end Usage;
220
221begin
222   if Ada.Command_Line.Argument_Count = 0 then
223      raise Program_Error;
224   end if;
225   Get_Top_Entities(Ada.Command_Line.Argument(1));
226exception
227   when Program_Error => Usage;
228end get_entities;
229