-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
--- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
--- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
--- Boston, MA 02110-1301, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- As a special exception, if other files instantiate generics from this --
--- unit, or you link this unit with other files to produce an executable, --
--- this unit does not by itself cause the resulting executable to be --
--- covered by the GNU General Public License. This exception does not --
--- however invalidate any other reasons why the executable file might be --
--- covered by the GNU Public License. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
-- Extensive contributions were provided by Ada Core Technologies Inc. --
Prev_Node.Set_Last (N);
-- Make sure we have no uninitialized junk in any new entires added.
- -- This ensures that Tree_Gen will not write out any unitialized junk.
+ -- This ensures that Tree_Gen will not write out any uninitialized junk.
for J in Old_Last + 1 .. N loop
Next_Node.Table (J) := Empty;
Append (Node, To);
end Append_To;
- -----------------
- -- Delete_List --
- -----------------
-
- procedure Delete_List (L : List_Id) is
- N : Node_Id;
-
- begin
- while Is_Non_Empty_List (L) loop
- N := Remove_Head (L);
- Delete_Tree (N);
- end loop;
-
- -- Should recycle list header???
- end Delete_List;
-
-----------
-- First --
-----------
if List = No_List then
return Empty;
else
- pragma Assert (List in First_List_Id .. Lists.Last);
+ pragma Assert (List <= Lists.Last);
return Lists.Table (List).First;
end if;
end First;
function First_Non_Pragma (List : List_Id) return Node_Id is
N : constant Node_Id := First (List);
-
begin
if Nkind (N) /= N_Pragma
and then
end if;
end Insert_List_Before_Debug;
- -- Start of prodcessing for Insert_List_Before
+ -- Start of processing for Insert_List_Before
begin
pragma Assert (Is_List_Member (Before));
function Is_Non_Empty_List (List : List_Id) return Boolean is
begin
- return List /= No_List and then First (List) /= Empty;
+ return First (List) /= Empty;
end Is_Non_Empty_List;
----------
function Last (List : List_Id) return Node_Id is
begin
- pragma Assert (List in First_List_Id .. Lists.Last);
+ pragma Assert (List <= Lists.Last);
return Lists.Table (List).Last;
end Last;
function Last_Non_Pragma (List : List_Id) return Node_Id is
N : constant Node_Id := Last (List);
-
begin
if Nkind (N) /= N_Pragma then
return N;
end if;
end New_Copy_List_Original;
- ------------------------
- -- New_Copy_List_Tree --
- ------------------------
-
- function New_Copy_List_Tree (List : List_Id) return List_Id is
- NL : List_Id;
- E : Node_Id;
-
- begin
- if List = No_List then
- return No_List;
-
- else
- NL := New_List;
- E := First (List);
-
- while Present (E) loop
- Append (New_Copy_Tree (E), NL);
- E := Next (E);
- end loop;
-
- return NL;
- end if;
- end New_Copy_List_Tree;
-
--------------
-- New_List --
--------------
function Parent (List : List_Id) return Node_Id is
begin
- pragma Assert (List in First_List_Id .. Lists.Last);
+ pragma Assert (List <= Lists.Last);
return Lists.Table (List).Parent;
end Parent;
procedure Set_Parent (List : List_Id; Node : Node_Id) is
begin
- pragma Assert (List in First_List_Id .. Lists.Last);
+ pragma Assert (List <= Lists.Last);
Lists.Table (List).Parent := Node;
end Set_Parent;
OSDN Git Service
