![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to generic_lists_of_vectors.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports|
Return to generic_lists_of_vectors.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports |
1.1 maekawa 1: package body Generic_Lists_of_Vectors is
2:
3: -- CONSTRUCTORS :
4:
5: function Deep_Create ( v : VecVec ) return List is
6:
7: res,res_last : List;
8:
9: begin
10: for i in v'range loop
11: Append(res,res_last,v(i).all);
12: end loop;
13: return res;
14: end Deep_Create;
15:
16: function Shallow_Create ( v : VecVec ) return List is
17:
18: res,res_last : List;
19:
20: begin
21: for i in v'range loop
22: Append(res,res_last,v(i));
23: end loop;
24: return res;
25: end Shallow_Create;
26:
27: function Deep_Create ( l : List ) return VecVec is
28:
29: res : VecVec(1..Length_Of(l));
30: tmp : List := l;
31:
32: begin
33: for i in res'range loop
34: declare
35: v : constant Vectors.Vector := Head_Of(tmp).all;
36: begin
37: res(i) := new vector'(v);
38: end;
39: tmp := Tail_Of(tmp);
40: end loop;
41: return res;
42: end Deep_Create;
43:
44: function Shallow_Create ( l : List ) return VecVec is
45:
46: res : VecVec(1..Length_Of(l));
47: tmp : List := l;
48:
49: begin
50: for i in res'range loop
51: res(i) := Head_Of(tmp);
52: tmp := Tail_Of(tmp);
53: end loop;
54: return res;
55: end Shallow_Create;
56:
57: procedure Copy ( l1 : in List; l2 : in out List ) is
58:
59: tmp,l2_last : List;
60: lv : Link_to_Vector;
61:
62: begin
63: Deep_Clear(l2);
64: tmp := l1;
65: while not Is_Null(tmp) loop
66: lv := Head_Of(tmp);
67: Append(l2,l2_last,lv.all);
68: tmp := Tail_Of(tmp);
69: end loop;
70: end Copy;
71:
72: procedure Append ( first,last : in out List; v : in Vector ) is
73:
74: lv : Link_to_Vector := new Vector'(v);
75:
76: begin
77: if Is_Null(first)
78: then Construct(lv,first);
79: last := first;
80: else declare
81: tmp : List;
82: begin
83: Construct(lv,tmp);
84: Swap_Tail(last,tmp);
85: last := Tail_Of(last);
86: end;
87: end if;
88: end Append;
89:
90: procedure Append_Diff ( first,last : in out List; v : in Vector ) is
91: begin
92: if not Is_In(first,v)
93: then Append(first,last,v);
94: end if;
95: end Append_Diff;
96:
97: procedure Append_Diff ( first,last : in out List; v : in Link_to_Vector ) is
98: begin
99: if v /= null and then not Is_In(first,v)
100: then Append(first,last,v);
101: end if;
102: end Append_Diff;
103:
104: procedure Deep_Concat ( first,last : in out List; l : in List ) is
105:
106: tmp : List;
107: lv : Link_to_Vector;
108:
109: begin
110: if not Is_Null(l)
111: then tmp := l;
112: while not Is_Null(tmp) loop
113: lv := Head_Of(tmp);
114: Append(first,last,lv.all);
115: tmp := Tail_Of(tmp);
116: end loop;
117: end if;
118: end Deep_Concat;
119:
120: procedure Shallow_Concat ( first,last : in out List; l : in List ) is
121: begin
122: Concat(first,last,l);
123: end Shallow_Concat;
124:
125: procedure Deep_Concat_Diff ( first,last : in out List; l : in List ) is
126:
127: tmp : List;
128: lv : Link_to_Vector;
129:
130: begin
131: if not Is_Null(l)
132: then tmp := l;
133: while not Is_Null(tmp) loop
134: lv := Head_Of(tmp);
135: Append_Diff(first,last,lv.all);
136: tmp := Tail_Of(tmp);
137: end loop;
138: end if;
139: end Deep_Concat_Diff;
140:
141: procedure Shallow_Concat_Diff ( first,last : in out List; l : in List ) is
142:
143: tmp : List;
144: lv : Link_to_Vector;
145:
146: begin
147: if not Is_Null(l)
148: then tmp := l;
149: while not Is_Null(tmp) loop
150: lv := Head_Of(tmp);
151: Append_Diff(first,last,lv);
152: tmp := Tail_Of(tmp);
153: end loop;
154: end if;
155: end Shallow_Concat_Diff;
156:
157: procedure Remove ( l : in out List; x : in Vector ) is
158:
159: lpt : Link_to_Vector;
160: found : boolean;
161: l1,l2 : List;
162:
163: begin
164: if not Is_Null(l)
165: then
166: lpt := Head_Of(l);
167: if lpt.all = x
168: then Clear(lpt);
169: l := Tail_Of(l);
170: else found := false;
171: l1 := l;
172: l2 := Tail_Of(l1);
173: while not Is_Null(l2) loop
174: lpt := Head_Of(l2);
175: found := (lpt.all = x);
176: exit when found;
177: l1 := l2;
178: l2 := Tail_Of(l1);
179: end loop;
180: if found
181: then Clear(lpt);
182: l2 := Tail_Of(l2);
183: Swap_Tail(l1,l2);
184: end if;
185: end if;
186: end if;
187: end Remove;
188:
189: procedure Remove ( l : in out List; x : in Link_to_Vector ) is
190: begin
191: if x /= null
192: then Remove(l,x.all);
193: end if;
194: end Remove;
195:
196: procedure Swap_to_Front ( l : in out List; x : in Vector ) is
197:
198: first : Link_to_Vector;
199: pt : Link_to_Vector;
200: tmp : List;
201: done : boolean := false;
202:
203: begin
204: if not Is_Null(l)
205: then first := Head_Of(l);
206: if first.all /= x
207: then tmp := Tail_Of(l);
208: while not Is_Null(tmp) loop
209: pt := Head_Of(tmp);
210: if pt.all = x
211: then Set_Head(tmp,first);
212: Set_Head(l,pt);
213: done := true;
214: end if;
215: exit when done;
216: tmp := Tail_Of(tmp);
217: end loop;
218: end if;
219: end if;
220: end Swap_to_Front;
221:
222: procedure Swap_to_Front ( l : in out List; x : in Link_to_Vector ) is
223: begin
224: if x /= null
225: then Swap_to_Front(l,x.all);
226: end if;
227: end Swap_to_Front;
228:
229: -- SELECTORS :
230:
231: function Is_In ( l : List; v : Vector ) return boolean is
232:
233: tmp : List;
234: v2 : Link_to_Vector;
235:
236: begin
237: tmp := l;
238: while not Is_Null(tmp) loop
239: v2 := Head_Of(tmp);
240: if Equal(v2.all,v)
241: then return true;
242: else tmp := Tail_Of(tmp);
243: end if;
244: end loop;
245: return false;
246: end Is_In;
247:
248: function Is_In ( l : List; v : Link_to_Vector ) return boolean is
249: begin
250: if v = null
251: then return false;
252: else return Is_In(l,v.all);
253: end if;
254: end Is_In;
255:
256: function Sub_List ( l1,l2 : List ) return boolean is
257:
258: tmp : List := l1;
259:
260: begin
261: while not Is_Null(tmp) loop
262: if not Is_In(l2,Head_Of(tmp))
263: then return false;
264: else tmp := Tail_Of(tmp);
265: end if;
266: end loop;
267: return true;
268: end Sub_List;
269:
270: function Equal ( l1,l2 : List ) return boolean is
271: begin
272: if not Sub_List(l1,l2)
273: then return false;
274: elsif not Sub_List(l2,l1)
275: then return false;
276: else return true;
277: end if;
278: end Equal;
279:
280: -- DESTRUCTORS :
281:
282: procedure Deep_Clear ( l : in out List ) is
283:
284: tmp : List;
285: v : Link_to_Vector;
286:
287: begin
288: tmp := l;
289: while not Is_Null(tmp) loop
290: v := Head_Of(tmp);
291: Clear(v);
292: tmp := Tail_Of(tmp);
293: end loop;
294: Shallow_Clear(l);
295: end Deep_Clear;
296:
297: procedure Shallow_Clear ( l : in out List ) is
298: begin
299: Vector_Lists.Clear(Vector_Lists.List(l));
300: end Shallow_Clear;
301:
302: end Generic_Lists_of_Vectors;