![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to brackets.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Schubert|
Return to brackets.adb CVS log | Up to [local] / OpenXM_contrib / PHC / Ada / Schubert |
1.1 maekawa 1: with unchecked_deallocation;
2:
3: package body Brackets is
4:
5: -- AUXILIARY OPERATION :
6:
7: procedure Swap ( v : in out Standard_Natural_Vectors.Vector;
8: i,j : in natural ) is
9:
10: -- DESCRIPTION :
11: -- Swaps the i-th and j-th entry in the vector v.
12:
13: tmp : natural := v(i);
14:
15: begin
16: v(i) := v(j); v(j) := tmp;
17: end Swap;
18:
19: -- CONSTRUCTORS :
20:
21: procedure Create ( v : in Standard_Natural_Vectors.Vector;
22: b : out Bracket; sign : out integer ) is
23:
24: sig : integer := +1;
25: min,ind : natural;
26: bb : Bracket(v'range) := Bracket(v);
27:
28: begin
29: for i in bb'first..bb'last-1 loop
30: min := bb(i);
31: ind := i;
32: for j in i+1..bb'last loop
33: if bb(j) < min
34: then ind := j;
35: min := bb(j);
36: end if;
37: end loop;
38: if ind /= i
39: then Swap(Standard_Natural_Vectors.Vector(bb),i,ind);
40: sig := -sig;
41: end if;
42: end loop;
43: b := bb;
44: sign := sig;
45: end Create;
46:
47: procedure Create ( v : in Standard_Natural_Vectors.Vector;
48: perm : out Standard_Natural_Vectors.Vector;
49: b : out Bracket; sign : out integer ) is
50:
51: sig : integer := +1;
52: min,ind : natural;
53: bb : Bracket(v'range) := Bracket(v);
54: pp : Standard_Natural_Vectors.Vector(v'range);
55:
56: begin
57: for i in pp'range loop
58: pp(i) := i;
59: end loop;
60: for i in bb'first..bb'last-1 loop
61: min := bb(i);
62: ind := i;
63: for j in i+1..bb'last loop
64: if bb(j) < min
65: then ind := j;
66: min := bb(j);
67: end if;
68: end loop;
69: if ind /= i
70: then Swap(Standard_Natural_Vectors.Vector(bb),i,ind);
71: Swap(pp,i,ind);
72: sig := -sig;
73: end if;
74: end loop;
75: perm := pp;
76: b := bb;
77: sign := sig;
78: end Create;
79:
80: function Modulo ( b : Bracket; n : natural ) return Bracket is
81:
82: res : Bracket(b'range);
83: modvec : Standard_Natural_Vectors.Vector(b'range);
84: sig : integer;
85:
86: begin
87: for i in b'range loop
88: modvec(i) := b(i) mod n;
89: if modvec(i) = 0
90: then modvec(i) := n;
91: end if;
92: end loop;
93: Create(modvec,res,sig);
94: return res;
95: end Modulo;
96:
97: procedure Modulo ( b : in Bracket; n : in natural;
98: perm : out Standard_Natural_Vectors.Vector;
99: mb : out Bracket ) is
100:
101: res : Bracket(b'range);
102: modvec : Standard_Natural_Vectors.Vector(b'range);
103: sig : integer;
104:
105: begin
106: for i in b'range loop
107: modvec(i) := b(i) mod n;
108: if modvec(i) = 0
109: then modvec(i) := n;
110: end if;
111: end loop;
112: Create(modvec,perm,res,sig);
113: mb := res;
114: end Modulo;
115:
116: -- SELECTORS :
117:
118: function Is_Zero ( b : Bracket ) return boolean is
119:
120: begin
121: for i in b'first..b'last-1 loop
122: if b(i) = b(i+1)
123: then return true;
124: end if;
125: end loop;
126: return false;
127: end Is_Zero;
128:
129: function Is_Equal ( b1,b2 : Bracket ) return boolean is
130:
131: use Standard_Natural_Vectors;
132:
133: begin
134: if b1'length /= b2'length
135: then return false;
136: else return Equal(Vector(b1),Vector(b2));
137: end if;
138: end Is_Equal;
139:
140: function "<" ( b1,b2 : Bracket ) return boolean is
141: begin
142: for i in b1'range loop
143: if b1(i) < b2(i)
144: then return true;
145: elsif b1(i) > b2(i)
146: then return false;
147: end if;
148: end loop;
149: return false;
150: end "<";
151:
152: function ">" ( b1,b2 : Bracket ) return boolean is
153: begin
154: for i in b1'range loop
155: if b1(i) > b2(i)
156: then return true;
157: elsif b1(i) < b2(i)
158: then return false;
159: end if;
160: end loop;
161: return false;
162: end ">";
163:
164: function Is_Standard ( b1,b2 : Bracket ) return natural is
165: begin
166: for i in b1'range loop
167: if b1(i) > b2(i)
168: then return i;
169: end if;
170: end loop;
171: return 0;
172: end Is_Standard;
173:
174: -- DESTRUCTOR :
175:
176: procedure Clear ( lb : in out Link_to_Bracket ) is
177:
178: procedure free is new unchecked_deallocation(Bracket,Link_to_Bracket);
179:
180: begin
181: free(lb);
182: end Clear;
183:
184: end Brackets;