Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Supports/generic_arrays_of_vector_lists.adb, Revision 1.1.1.1
1.1 maekawa 1: with unchecked_deallocation;
2:
3: package body Generic_Arrays_of_Vector_Lists is
4:
5: -- COMPARISON and COPYING :
6:
7: function Equal ( l1,l2 : Array_of_Lists ) return boolean is
8: begin
9: if l1'first /= l2'first or else l1'last /= l2'last
10: then return false;
11: else for k in l1'range loop
12: if not Equal(l1(k),l2(k))
13: then return false;
14: end if;
15: end loop;
16: return true;
17: end if;
18: end Equal;
19:
20: function Equal ( l1,l2 : Link_to_Array_of_Lists ) return boolean is
21: begin
22: if l1 = null and then l2 /= null
23: then return false;
24: elsif l2 = null
25: then return true;
26: else return Equal(l1.all,l2.all);
27: end if;
28: end Equal;
29:
30: procedure Copy ( l1 : in Array_of_Lists; l2 : in out Array_of_Lists ) is
31: begin
32: for k in l1'range loop
33: Copy(l1(k),l2(k));
34: end loop;
35: end Copy;
36:
37: -- SELECTOR :
38:
39: function Length_Of ( l : Array_of_Lists ) return natural is
40:
41: res : natural := 0;
42:
43: begin
44: for i in l'range loop
45: res := res + Length_Of(l(i));
46: end loop;
47: return res;
48: end Length_Of;
49:
50: -- DESTRUCTORS :
51:
52: procedure free is new unchecked_deallocation
53: (Array_of_Lists,Link_to_Array_of_Lists);
54:
55: procedure Deep_Clear ( l : in out Array_of_Lists ) is
56: begin
57: for k in l'range loop
58: Deep_Clear(l(k));
59: end loop;
60: end Deep_Clear;
61:
62: procedure Shallow_Clear ( l : in out Array_of_Lists ) is
63: begin
64: for k in l'range loop
65: Shallow_Clear(l(k));
66: end loop;
67: end Shallow_Clear;
68:
69: procedure Deep_Clear ( l : in out Link_to_Array_of_Lists ) is
70: begin
71: if l /= null
72: then Deep_Clear(l.all); free(l);
73: end if;
74: end Deep_Clear;
75:
76: procedure Shallow_Clear ( l : in out Link_to_Array_of_Lists ) is
77: begin
78: if l /= null
79: then Shallow_Clear(l.all); free(l);
80: end if;
81: end Shallow_Clear;
82:
83: end Generic_Arrays_of_Vector_Lists;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>