1--
2-- Copyright (c) 2008-2009 Tero Koskinen <tero.koskinen@iki.fi>
3--
4-- Permission to use, copy, modify, and distribute this software for any
5-- purpose with or without fee is hereby granted, provided that the above
6-- copyright notice and this permission notice appear in all copies.
7--
8-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15--
16with Ada.Unchecked_Deallocation;
17
18package body Ahven.SList is
19   procedure Remove (Ptr : Node_Access) is
20      procedure Free is
21        new Ada.Unchecked_Deallocation (Object => Node,
22                                        Name   => Node_Access);
23      My_Ptr : Node_Access := Ptr;
24   begin
25      Ptr.Next := null;
26      Free (My_Ptr);
27   end Remove;
28
29   procedure Append (Target : in out List;
30                     Node_Data : Element_Type) is
31      New_Node : Node_Access  := null;
32   begin
33      if Target.Size = Count_Type'Last then
34         raise List_Full;
35      end if;
36
37      New_Node := new Node'(Data => Node_Data, Next => null);
38
39      if Target.Last = null then
40         Target.First := New_Node;
41      else
42         Target.Last.Next := New_Node;
43      end if;
44      Target.Last := New_Node;
45
46      Target.Size := Target.Size + 1;
47   end Append;
48
49   procedure Clear (Target : in out List) is
50      Current_Node : Node_Access := Target.First;
51      Next_Node : Node_Access := null;
52   begin
53      while Current_Node /= null loop
54         Next_Node := Current_Node.Next;
55         Remove (Current_Node);
56         Current_Node := Next_Node;
57      end loop;
58
59      Target.First := null;
60      Target.Last := null;
61      Target.Size := 0;
62   end Clear;
63
64   function First (Target : List) return Cursor is
65   begin
66      return Cursor (Target.First);
67   end First;
68
69   function Next (Position : Cursor) return Cursor is
70   begin
71      if Position = null then
72         raise Invalid_Cursor;
73      end if;
74      return Cursor (Position.Next);
75   end Next;
76
77   function Data (Position : Cursor) return Element_Type is
78   begin
79      if Position = null then
80         raise Invalid_Cursor;
81      end if;
82
83      return Position.Data;
84   end Data;
85
86   function Is_Valid (Position : Cursor) return Boolean is
87   begin
88      return Position /= null;
89   end Is_Valid;
90
91   function Length (Target : List) return Count_Type is
92   begin
93      return Target.Size;
94   end Length;
95
96   procedure For_Each (Target : List) is
97      Current_Node : Node_Access := Target.First;
98   begin
99      while Current_Node /= null loop
100         Action (Current_Node.Data);
101         Current_Node := Current_Node.Next;
102      end loop;
103   end For_Each;
104
105   procedure Initialize (Target : in out List) is
106   begin
107      Target.Last := null;
108      Target.First := null;
109      Target.Size := 0;
110   end Initialize;
111
112   procedure Finalize (Target : in out List) is
113   begin
114      Clear (Target);
115   end Finalize;
116
117   procedure Adjust (Target : in out List) is
118      Target_Last  : Node_Access := null;
119      Target_First : Node_Access := null;
120      Current      : Node_Access := Target.First;
121      New_Node     : Node_Access;
122   begin
123      -- Recreate the list using the same data
124      while Current /= null loop
125         New_Node := new Node'(Data => Current.Data, Next => null);
126
127         if Target_Last = null then
128            Target_First := New_Node;
129         else
130            Target_Last.Next := New_Node;
131         end if;
132         Target_Last := New_Node;
133
134         Current := Current.Next;
135      end loop;
136      Target.First := Target_First;
137      Target.Last := Target_Last;
138
139      -- No need to adjust size, it is same as before copying
140   end Adjust;
141end Ahven.SList;
142