![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to transforming_integer_vector_lists.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift|
Return to transforming_integer_vector_lists.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift |
1.1 maekawa 1: with Integer_Vectors_Utilities; use Integer_Vectors_Utilities;
2:
3: package body Transforming_Integer_Vector_Lists is
4:
5: procedure Shift ( l : in out List; v : in Vector ) is
6:
7: tmp : List := l;
8:
9: begin
10: while not Is_Null(tmp) loop
11: declare
12: lv : Link_to_Vector := Head_Of(tmp);
13: begin
14: lv.all := lv.all - v;
15: Set_Head(tmp,lv);
16: end;
17: tmp := Tail_Of(tmp);
18: end loop;
19: end Shift;
20:
21: procedure Shift ( l : in out List; v : in Link_to_Vector ) is
22: begin
23: if v /= null
24: then Shift(l,v.all);
25: end if;
26: end Shift;
27:
28: function Shift ( l : List; v : Vector ) return List is
29:
30: tmp,res,res_last : List;
31: v1 : Vector(v'range);
32:
33: begin
34: tmp := l;
35: while not Is_Null(tmp) loop
36: v1 := Head_Of(tmp).all;
37: declare
38: v2 : Vector(v1'range) := v1 - v;
39: begin
40: Append(res,res_last,v2);
41: end;
42: tmp := Tail_Of(tmp);
43: end loop;
44: return res;
45: end Shift;
46:
47: function Shift ( l : List; v : Link_to_Vector ) return List is
48: begin
49: if v = null
50: then declare
51: res : List;
52: begin
53: Copy(l,res);
54: return res;
55: end;
56: else return Shift(l,v.all);
57: end if;
58: end Shift;
59:
60: function "*"( l : List; t : Transfo ) return List is
61: begin
62: return t*l;
63: end "*";
64:
65: function "*"( t : Transfo; l : List ) return List is
66:
67: tmp,res,res_last : List;
68: d,td : Link_to_Vector;
69:
70: begin
71: tmp := l;
72: while not Is_Null(tmp) loop
73: d := Head_Of(tmp);
74: td := t*d;
75: Append(res,res_last,td);
76: tmp := Tail_Of(tmp);
77: end loop;
78: return res;
79: end "*";
80:
81: procedure Apply ( l : in out List; t : in Transfo ) is
82:
83: res : List := t*l;
84:
85: begin
86: Copy(res,l);
87: end Apply;
88:
89: function Reduce ( l : List; i : integer ) return List is
90:
91: tmp,res,res_last : List;
92:
93: begin
94: tmp := l;
95: while not Is_Null(tmp) loop
96: declare
97: d1 : Link_to_Vector := Head_Of(tmp);
98: d2 : Link_to_Vector := Reduce(d1,i);
99: begin
100: -- Append_Diff(res,res_last,d2); -- be aware of duplicates !
101: Append(res,res_last,d2); -- be aware of duplicates !
102: end;
103: tmp := Tail_Of(tmp);
104: end loop;
105: return res;
106: end Reduce;
107:
108: procedure Reduce ( l : in out List; i : in integer ) is
109:
110: res : List := Reduce(l,i);
111:
112: begin
113: Copy(res,l);
114: end Reduce;
115:
116: function Insert ( l : List; i,a : integer ) return List is
117:
118: tmp,res,res_last : List;
119:
120: begin
121: tmp := l;
122: while not Is_Null(tmp) loop
123: declare
124: d1 : Link_to_Vector := Head_Of(tmp);
125: d2 : Link_to_Vector := Insert(d1,i,a);
126: begin
127: Append(res,res_last,d2);
128: end;
129: tmp := Tail_Of(tmp);
130: end loop;
131: return res;
132: end Insert;
133:
134: procedure Insert ( l : in out List; i,a : in integer ) is
135:
136: res : List := Insert(l,i,a);
137:
138: begin
139: Deep_Clear(l);
140: l := res;
141: end Insert;
142:
143: function Transform_and_Reduce ( t : Transfo; i : integer; l : List )
144: return List is
145: tmp,res,res_last : List;
146:
147: begin
148: tmp := l;
149: while not Is_Null(tmp) loop
150: declare
151: d : Link_to_Vector := Head_Of(tmp);
152: td : Vector(d'range) := t*d.all;
153: dr : Link_to_Vector := new Vector'(Reduce(td,i));
154: begin
155: Append(res,res_last,dr);
156: end;
157: tmp := Tail_Of(tmp);
158: end loop;
159: return res;
160: end Transform_and_Reduce;
161:
162: procedure Transform_and_Reduce ( t : in Transfo; i : in integer;
163: l : in out List ) is
164:
165: res : List := Transform_and_Reduce(t,i,l);
166:
167: begin
168: Deep_Clear(l);
169: l := res;
170: end Transform_and_Reduce;
171:
172: function Insert_and_Transform ( l : List; i,a : integer; t : Transfo )
173: return List is
174:
175: tmp,res,res_last : List;
176:
177: begin
178: tmp := l;
179: while not Is_Null(tmp) loop
180: declare
181: d : Link_to_Vector := Insert_and_Transform(Head_Of(tmp),i,a,t);
182: begin
183: Append(res,res_last,d);
184: end;
185: tmp := Tail_Of(tmp);
186: end loop;
187: return res;
188: end Insert_and_Transform;
189:
190: procedure Insert_and_Transform
191: ( l : in out List; i,a : in integer; t : in Transfo ) is
192:
193: res : List := Insert_and_Transform(l,i,a,t);
194:
195: begin
196: Deep_Clear(l);
197: l := res;
198: end Insert_and_Transform;
199:
200: end Transforming_Integer_Vector_Lists;