Annotation of OpenXM_contrib/PHC/Ada/Continuation/continuation_data.adb, Revision 1.1.1.1
1.1 maekawa 1: package body Continuation_Data is
2:
3: -- AUXILIARY :
4:
5: procedure Append ( first,last : in out Solution_List;
6: ls : in Link_to_Solution ) is
7: begin
8: if Is_Null(first)
9: then Construct(ls,first);
10: last := first;
11: else declare
12: tmp : Solution_List;
13: begin
14: Construct(ls,tmp);
15: Swap_Tail(last,tmp);
16: last := Tail_Of(last);
17: end;
18: end if;
19: end Append;
20:
21: -- CREATORS :
22:
23: function Shallow_Create ( s : Link_to_Solution ) return Solu_Info is
24:
25: res : Solu_Info;
26:
27: begin
28: res.sol := s;
29: Init_Info(res);
30: return res;
31: end Shallow_Create;
32:
33: function Deep_Create ( s : Solution ) return Solu_Info is
34:
35: res : Solu_Info;
36:
37: begin
38: res.sol := new Solution'(s);
39: Init_Info(res);
40: return res;
41: end Deep_Create;
42:
43: function Shallow_Create ( s : Solution_Array ) return Solu_Info_Array is
44:
45: res : Solu_Info_Array(s'range);
46:
47: begin
48: for k in res'range loop
49: res(k) := Shallow_Create(s(k));
50: end loop;
51: return res;
52: end Shallow_Create;
53:
54: function Deep_Create ( s : Solution_Array ) return Solu_Info_Array is
55:
56: res : Solu_Info_Array(s'range);
57:
58: begin
59: for k in res'range loop
60: res(k) := Deep_Create(s(k).all);
61: end loop;
62: return res;
63: end Deep_Create;
64:
65: function Shallow_Create ( s : Solution_List ) return Solu_Info_Array is
66:
67: res : Solu_Info_Array(1..Length_Of(s));
68: tmp : Solution_List := s;
69:
70: begin
71: for k in res'range loop
72: res(k) := Shallow_Create(Head_Of(tmp));
73: tmp := Tail_Of(tmp);
74: end loop;
75: return res;
76: end Shallow_Create;
77:
78: function Deep_Create ( s : Solution_List ) return Solu_Info_Array is
79:
80: res : Solu_Info_Array(1..Length_Of(s));
81: tmp : Solution_List := s;
82:
83: begin
84: for k in res'range loop
85: res(k) := Deep_Create(Head_Of(tmp).all);
86: tmp := Tail_Of(tmp);
87: end loop;
88: return res;
89: end Deep_Create;
90:
91: function Shallow_Create ( s : Solu_Info ) return Link_to_Solution is
92: begin
93: s.sol.err := s.cora;
94: s.sol.rco := s.rcond;
95: s.sol.res := s.resa;
96: return s.sol;
97: end Shallow_Create;
98:
99: function Deep_Create ( s : Solu_Info ) return Solution is
100: begin
101: s.sol.err := s.cora;
102: s.sol.rco := s.rcond;
103: s.sol.res := s.resa;
104: return s.sol.all;
105: end Deep_Create;
106:
107: function Shallow_Create ( s : Solu_Info_Array ) return Solution_Array is
108:
109: res : Solution_Array(s'range);
110:
111: begin
112: for k in s'range loop
113: res(k) := Shallow_Create(s(k));
114: end loop;
115: return res;
116: end Shallow_Create;
117:
118: function Deep_Create ( s : Solu_Info_Array ) return Solution_Array is
119:
120: res : Solution_Array(s'range);
121:
122: begin
123: for k in s'range loop
124: res(k) := new Solution'(Deep_Create(s(k)));
125: end loop;
126: return res;
127: end Deep_Create;
128:
129: function Shallow_Create ( s : Solu_Info_Array ) return Solution_List is
130:
131: res,res_last : Solution_List;
132:
133: begin
134: for k in s'range loop
135: Append(res,res_last,Shallow_Create(s(k)));
136: end loop;
137: return res;
138: end Shallow_Create;
139:
140: function Deep_Create ( s : Solu_Info_Array ) return Solution_List is
141:
142: res,res_last : Solution_List;
143:
144: begin
145: for k in s'range loop
146: Append(res,res_last,Deep_Create(s(k)));
147: end loop;
148: return res;
149: end Deep_Create;
150:
151: -- OPERATIONS ON Solu_Info :
152:
153: procedure Copy_Info ( s1 : in Solu_Info; s2 : in out Solu_Info ) is
154: begin
155: s2.corr := s1.corr; s2.cora := s1.cora;
156: s2.resr := s1.resr; s2.resa := s1.resa;
157: s2.rcond := s1.rcond; s2.length_path := s1.length_path;
158: s2.nstep := s1.nstep; s2.nfail := s1.nfail;
159: s2.niter := s1.niter; s2.nsyst := s1.nsyst;
160: end Copy_Info;
161:
162: procedure Copy_Solu ( s1 : in Solu_Info; s2 : in out Solu_Info ) is
163: begin
164: Clear(s2.sol);
165: s2.sol := new Solution'(s1.sol.all);
166: end Copy_Solu;
167:
168: procedure Copy ( s1 : in Solu_Info; s2 : in out Solu_Info ) is
169: begin
170: Copy_Info(s1,s2);
171: Copy_Solu(s1,s2);
172: end Copy;
173:
174: procedure Init_Info ( s : in out Solu_Info ) is
175: begin
176: s.corr := 0.0; s.cora := 0.0; s.resr := 0.0; s.resa := 0.0; s.rcond := 0.0;
177: s.length_path := 0.0;
178: s.nstep := 0; s.nfail := 0; s.niter := 0; s.nsyst := 0;
179: end Init_Info;
180:
181: procedure Add_Info ( s1 : in out Solu_Info; s2 : in Solu_Info ) is
182: begin
183: s1.nstep := s1.nstep + s2.nstep;
184: s1.nfail := s1.nfail + s2.nfail;
185: s1.niter := s1.niter + s2.niter;
186: s1.nsyst := s1.nsyst + s2.niter;
187: s1.length_path := s1.length_path + s2.length_path;
188: end Add_Info;
189:
190: procedure Update_Info ( s1 : in out Solu_Info; s2 : in Solu_Info ) is
191: begin
192: s1.corr := s2.corr; s1.cora := s2.cora;
193: s1.resr := s2.resr; s1.resa := s2.resa;
194: s1.rcond := s2.rcond;
195: Add_Info(s1,s2);
196: end Update_Info;
197:
198: -- OPERATIONS ON Solu_Info_Array :
199:
200: procedure Copy ( s : in Solu_Info_Array; sa : in out Solution_Array ) is
201: begin
202: Clear(sa);
203: for k in s'range loop
204: sa(k) := new Solution'(s(k).sol.all);
205: end loop;
206: end Copy;
207:
208: procedure Copy ( sa : in Solution_Array; s : in out Solu_Info_Array ) is
209: begin
210: for k in sa'range loop
211: Clear(s(k).sol);
212: s(k).sol := new Solution'(sa(k).all);
213: end loop;
214: end Copy;
215:
216: -- DESTRUCTORS :
217:
218: procedure Clear ( s : in out Solu_Info ) is
219: begin
220: Clear(s.sol);
221: end Clear;
222:
223: procedure Clear ( s : in out Solu_Info_Array ) is
224: begin
225: for k in s'range loop
226: Clear(s);
227: end loop;
228: end Clear;
229:
230: end Continuation_Data;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to continuation_data.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Continuation