Annotation of OpenXM_contrib/PHC/Ada/Continuation/continuation_data.adb, Revision 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