Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/integer_vectors_utilities.adb, Revision 1.1.1.1
1.1 maekawa 1: package body Integer_Vectors_Utilities is
2:
3: function Pivot ( v : Vector ) return integer is
4: begin
5: for i in v'range loop
6: if v(i) /= 0
7: then return i;
8: end if;
9: end loop;
10: return (v'last + 1);
11: end Pivot;
12:
13: function Pivot ( v : Link_to_Vector ) return integer is
14: begin
15: if v = null
16: then return 0;
17: else return Pivot(v.all);
18: end if;
19: end Pivot;
20:
21: function Reduce ( v : Vector; i : integer ) return Vector is
22:
23: res : Vector(v'first..(v'last-1));
24:
25: begin
26: for j in res'range loop
27: if j < i
28: then res(j) := v(j);
29: else res(j) := v(j+1);
30: end if;
31: end loop;
32: return res;
33: end Reduce;
34:
35: function Reduce ( v : Link_to_Vector; i : integer ) return Link_to_Vector is
36: begin
37: if v = null
38: then return v;
39: else declare
40: res : Link_to_Vector := new Vector'(Reduce(v.all,i));
41: begin
42: return res;
43: end;
44: end if;
45: end Reduce;
46:
47: procedure Reduce ( v : in out Link_to_Vector; i : in integer ) is
48: begin
49: if v /= null
50: then declare
51: res : constant Vector := Reduce(v.all,i);
52: begin
53: Clear(v);
54: v := new Vector'(res);
55: end;
56: end if;
57: end Reduce;
58:
59: function Insert ( v : Vector; i,a : integer ) return Vector is
60:
61: res : Vector(v'first..(v'last+1));
62:
63: begin
64: for j in res'first..(i-1) loop
65: res(j) := v(j);
66: end loop;
67: res(i) := a;
68: for j in (i+1)..res'last loop
69: res(j) := v(j-1);
70: end loop;
71: return res;
72: end Insert;
73:
74: function Insert ( v : Link_to_Vector; i,a : integer )
75: return Link_to_Vector is
76:
77: res : Link_to_Vector;
78:
79: begin
80: if v = null
81: then res := new Vector'(i..i => a);
82: else res := new Vector'(Insert(v.all,i,a));
83: end if;
84: return res;
85: end Insert;
86:
87: procedure Insert ( v : in out Link_to_Vector; i,a : in integer ) is
88: begin
89: if v /= null
90: then declare
91: res : constant Vector := Insert(v.all,i,a);
92: begin
93: Clear(v);
94: v := new Vector'(res);
95: end;
96: end if;
97: end Insert;
98:
99: function Insert_and_Transform
100: ( v : Vector; i,a : integer; t : Transfo ) return Vector is
101:
102: res : Vector(v'first..v'last+1) := Insert(v,i,a);
103:
104: begin
105: Apply(t,res);
106: return res;
107: end Insert_and_Transform;
108:
109: procedure Insert_and_Transform
110: ( v : in out Link_to_Vector; i,a : in integer; t : in Transfo ) is
111: res : Link_to_Vector;
112: begin
113: res := Insert_and_Transform(v,i,a,t);
114: Clear(v);
115: v := res;
116: end Insert_and_Transform;
117:
118: function Insert_and_Transform
119: ( v : Link_to_Vector; i,a : integer; t : Transfo )
120: return Link_to_Vector is
121:
122: res : Link_to_Vector;
123:
124: begin
125: if v = null
126: then res := Insert(v,i,a);
127: Apply(t,res.all);
128: else res := new Vector'(Insert_and_Transform(v.all,i,a,t));
129: end if;
130: return res;
131: end Insert_and_Transform;
132:
133: end Integer_Vectors_Utilities;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>