Annotation of OpenXM_contrib/PHC/Ada/Math_Lib/Supports/generic_lists_of_vectors.adb, Revision 1.1
1.1 ! maekawa 1: package body Generic_Lists_of_Vectors is
! 2:
! 3: -- CONSTRUCTORS :
! 4:
! 5: function Deep_Create ( v : VecVec ) return List is
! 6:
! 7: res,res_last : List;
! 8:
! 9: begin
! 10: for i in v'range loop
! 11: Append(res,res_last,v(i).all);
! 12: end loop;
! 13: return res;
! 14: end Deep_Create;
! 15:
! 16: function Shallow_Create ( v : VecVec ) return List is
! 17:
! 18: res,res_last : List;
! 19:
! 20: begin
! 21: for i in v'range loop
! 22: Append(res,res_last,v(i));
! 23: end loop;
! 24: return res;
! 25: end Shallow_Create;
! 26:
! 27: function Deep_Create ( l : List ) return VecVec is
! 28:
! 29: res : VecVec(1..Length_Of(l));
! 30: tmp : List := l;
! 31:
! 32: begin
! 33: for i in res'range loop
! 34: declare
! 35: v : constant Vectors.Vector := Head_Of(tmp).all;
! 36: begin
! 37: res(i) := new vector'(v);
! 38: end;
! 39: tmp := Tail_Of(tmp);
! 40: end loop;
! 41: return res;
! 42: end Deep_Create;
! 43:
! 44: function Shallow_Create ( l : List ) return VecVec is
! 45:
! 46: res : VecVec(1..Length_Of(l));
! 47: tmp : List := l;
! 48:
! 49: begin
! 50: for i in res'range loop
! 51: res(i) := Head_Of(tmp);
! 52: tmp := Tail_Of(tmp);
! 53: end loop;
! 54: return res;
! 55: end Shallow_Create;
! 56:
! 57: procedure Copy ( l1 : in List; l2 : in out List ) is
! 58:
! 59: tmp,l2_last : List;
! 60: lv : Link_to_Vector;
! 61:
! 62: begin
! 63: Deep_Clear(l2);
! 64: tmp := l1;
! 65: while not Is_Null(tmp) loop
! 66: lv := Head_Of(tmp);
! 67: Append(l2,l2_last,lv.all);
! 68: tmp := Tail_Of(tmp);
! 69: end loop;
! 70: end Copy;
! 71:
! 72: procedure Append ( first,last : in out List; v : in Vector ) is
! 73:
! 74: lv : Link_to_Vector := new Vector'(v);
! 75:
! 76: begin
! 77: if Is_Null(first)
! 78: then Construct(lv,first);
! 79: last := first;
! 80: else declare
! 81: tmp : List;
! 82: begin
! 83: Construct(lv,tmp);
! 84: Swap_Tail(last,tmp);
! 85: last := Tail_Of(last);
! 86: end;
! 87: end if;
! 88: end Append;
! 89:
! 90: procedure Append_Diff ( first,last : in out List; v : in Vector ) is
! 91: begin
! 92: if not Is_In(first,v)
! 93: then Append(first,last,v);
! 94: end if;
! 95: end Append_Diff;
! 96:
! 97: procedure Append_Diff ( first,last : in out List; v : in Link_to_Vector ) is
! 98: begin
! 99: if v /= null and then not Is_In(first,v)
! 100: then Append(first,last,v);
! 101: end if;
! 102: end Append_Diff;
! 103:
! 104: procedure Deep_Concat ( first,last : in out List; l : in List ) is
! 105:
! 106: tmp : List;
! 107: lv : Link_to_Vector;
! 108:
! 109: begin
! 110: if not Is_Null(l)
! 111: then tmp := l;
! 112: while not Is_Null(tmp) loop
! 113: lv := Head_Of(tmp);
! 114: Append(first,last,lv.all);
! 115: tmp := Tail_Of(tmp);
! 116: end loop;
! 117: end if;
! 118: end Deep_Concat;
! 119:
! 120: procedure Shallow_Concat ( first,last : in out List; l : in List ) is
! 121: begin
! 122: Concat(first,last,l);
! 123: end Shallow_Concat;
! 124:
! 125: procedure Deep_Concat_Diff ( first,last : in out List; l : in List ) is
! 126:
! 127: tmp : List;
! 128: lv : Link_to_Vector;
! 129:
! 130: begin
! 131: if not Is_Null(l)
! 132: then tmp := l;
! 133: while not Is_Null(tmp) loop
! 134: lv := Head_Of(tmp);
! 135: Append_Diff(first,last,lv.all);
! 136: tmp := Tail_Of(tmp);
! 137: end loop;
! 138: end if;
! 139: end Deep_Concat_Diff;
! 140:
! 141: procedure Shallow_Concat_Diff ( first,last : in out List; l : in List ) is
! 142:
! 143: tmp : List;
! 144: lv : Link_to_Vector;
! 145:
! 146: begin
! 147: if not Is_Null(l)
! 148: then tmp := l;
! 149: while not Is_Null(tmp) loop
! 150: lv := Head_Of(tmp);
! 151: Append_Diff(first,last,lv);
! 152: tmp := Tail_Of(tmp);
! 153: end loop;
! 154: end if;
! 155: end Shallow_Concat_Diff;
! 156:
! 157: procedure Remove ( l : in out List; x : in Vector ) is
! 158:
! 159: lpt : Link_to_Vector;
! 160: found : boolean;
! 161: l1,l2 : List;
! 162:
! 163: begin
! 164: if not Is_Null(l)
! 165: then
! 166: lpt := Head_Of(l);
! 167: if lpt.all = x
! 168: then Clear(lpt);
! 169: l := Tail_Of(l);
! 170: else found := false;
! 171: l1 := l;
! 172: l2 := Tail_Of(l1);
! 173: while not Is_Null(l2) loop
! 174: lpt := Head_Of(l2);
! 175: found := (lpt.all = x);
! 176: exit when found;
! 177: l1 := l2;
! 178: l2 := Tail_Of(l1);
! 179: end loop;
! 180: if found
! 181: then Clear(lpt);
! 182: l2 := Tail_Of(l2);
! 183: Swap_Tail(l1,l2);
! 184: end if;
! 185: end if;
! 186: end if;
! 187: end Remove;
! 188:
! 189: procedure Remove ( l : in out List; x : in Link_to_Vector ) is
! 190: begin
! 191: if x /= null
! 192: then Remove(l,x.all);
! 193: end if;
! 194: end Remove;
! 195:
! 196: procedure Swap_to_Front ( l : in out List; x : in Vector ) is
! 197:
! 198: first : Link_to_Vector;
! 199: pt : Link_to_Vector;
! 200: tmp : List;
! 201: done : boolean := false;
! 202:
! 203: begin
! 204: if not Is_Null(l)
! 205: then first := Head_Of(l);
! 206: if first.all /= x
! 207: then tmp := Tail_Of(l);
! 208: while not Is_Null(tmp) loop
! 209: pt := Head_Of(tmp);
! 210: if pt.all = x
! 211: then Set_Head(tmp,first);
! 212: Set_Head(l,pt);
! 213: done := true;
! 214: end if;
! 215: exit when done;
! 216: tmp := Tail_Of(tmp);
! 217: end loop;
! 218: end if;
! 219: end if;
! 220: end Swap_to_Front;
! 221:
! 222: procedure Swap_to_Front ( l : in out List; x : in Link_to_Vector ) is
! 223: begin
! 224: if x /= null
! 225: then Swap_to_Front(l,x.all);
! 226: end if;
! 227: end Swap_to_Front;
! 228:
! 229: -- SELECTORS :
! 230:
! 231: function Is_In ( l : List; v : Vector ) return boolean is
! 232:
! 233: tmp : List;
! 234: v2 : Link_to_Vector;
! 235:
! 236: begin
! 237: tmp := l;
! 238: while not Is_Null(tmp) loop
! 239: v2 := Head_Of(tmp);
! 240: if Equal(v2.all,v)
! 241: then return true;
! 242: else tmp := Tail_Of(tmp);
! 243: end if;
! 244: end loop;
! 245: return false;
! 246: end Is_In;
! 247:
! 248: function Is_In ( l : List; v : Link_to_Vector ) return boolean is
! 249: begin
! 250: if v = null
! 251: then return false;
! 252: else return Is_In(l,v.all);
! 253: end if;
! 254: end Is_In;
! 255:
! 256: function Sub_List ( l1,l2 : List ) return boolean is
! 257:
! 258: tmp : List := l1;
! 259:
! 260: begin
! 261: while not Is_Null(tmp) loop
! 262: if not Is_In(l2,Head_Of(tmp))
! 263: then return false;
! 264: else tmp := Tail_Of(tmp);
! 265: end if;
! 266: end loop;
! 267: return true;
! 268: end Sub_List;
! 269:
! 270: function Equal ( l1,l2 : List ) return boolean is
! 271: begin
! 272: if not Sub_List(l1,l2)
! 273: then return false;
! 274: elsif not Sub_List(l2,l1)
! 275: then return false;
! 276: else return true;
! 277: end if;
! 278: end Equal;
! 279:
! 280: -- DESTRUCTORS :
! 281:
! 282: procedure Deep_Clear ( l : in out List ) is
! 283:
! 284: tmp : List;
! 285: v : Link_to_Vector;
! 286:
! 287: begin
! 288: tmp := l;
! 289: while not Is_Null(tmp) loop
! 290: v := Head_Of(tmp);
! 291: Clear(v);
! 292: tmp := Tail_Of(tmp);
! 293: end loop;
! 294: Shallow_Clear(l);
! 295: end Deep_Clear;
! 296:
! 297: procedure Shallow_Clear ( l : in out List ) is
! 298: begin
! 299: Vector_Lists.Clear(Vector_Lists.List(l));
! 300: end Shallow_Clear;
! 301:
! 302: end Generic_Lists_of_Vectors;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to generic_lists_of_vectors.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Math_Lib / Supports