Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/transforming_integer_vector_lists.adb, Revision 1.1
1.1 ! maekawa 1: with Integer_Vectors_Utilities; use Integer_Vectors_Utilities;
! 2:
! 3: package body Transforming_Integer_Vector_Lists is
! 4:
! 5: procedure Shift ( l : in out List; v : in Vector ) is
! 6:
! 7: tmp : List := l;
! 8:
! 9: begin
! 10: while not Is_Null(tmp) loop
! 11: declare
! 12: lv : Link_to_Vector := Head_Of(tmp);
! 13: begin
! 14: lv.all := lv.all - v;
! 15: Set_Head(tmp,lv);
! 16: end;
! 17: tmp := Tail_Of(tmp);
! 18: end loop;
! 19: end Shift;
! 20:
! 21: procedure Shift ( l : in out List; v : in Link_to_Vector ) is
! 22: begin
! 23: if v /= null
! 24: then Shift(l,v.all);
! 25: end if;
! 26: end Shift;
! 27:
! 28: function Shift ( l : List; v : Vector ) return List is
! 29:
! 30: tmp,res,res_last : List;
! 31: v1 : Vector(v'range);
! 32:
! 33: begin
! 34: tmp := l;
! 35: while not Is_Null(tmp) loop
! 36: v1 := Head_Of(tmp).all;
! 37: declare
! 38: v2 : Vector(v1'range) := v1 - v;
! 39: begin
! 40: Append(res,res_last,v2);
! 41: end;
! 42: tmp := Tail_Of(tmp);
! 43: end loop;
! 44: return res;
! 45: end Shift;
! 46:
! 47: function Shift ( l : List; v : Link_to_Vector ) return List is
! 48: begin
! 49: if v = null
! 50: then declare
! 51: res : List;
! 52: begin
! 53: Copy(l,res);
! 54: return res;
! 55: end;
! 56: else return Shift(l,v.all);
! 57: end if;
! 58: end Shift;
! 59:
! 60: function "*"( l : List; t : Transfo ) return List is
! 61: begin
! 62: return t*l;
! 63: end "*";
! 64:
! 65: function "*"( t : Transfo; l : List ) return List is
! 66:
! 67: tmp,res,res_last : List;
! 68: d,td : Link_to_Vector;
! 69:
! 70: begin
! 71: tmp := l;
! 72: while not Is_Null(tmp) loop
! 73: d := Head_Of(tmp);
! 74: td := t*d;
! 75: Append(res,res_last,td);
! 76: tmp := Tail_Of(tmp);
! 77: end loop;
! 78: return res;
! 79: end "*";
! 80:
! 81: procedure Apply ( l : in out List; t : in Transfo ) is
! 82:
! 83: res : List := t*l;
! 84:
! 85: begin
! 86: Copy(res,l);
! 87: end Apply;
! 88:
! 89: function Reduce ( l : List; i : integer ) return List is
! 90:
! 91: tmp,res,res_last : List;
! 92:
! 93: begin
! 94: tmp := l;
! 95: while not Is_Null(tmp) loop
! 96: declare
! 97: d1 : Link_to_Vector := Head_Of(tmp);
! 98: d2 : Link_to_Vector := Reduce(d1,i);
! 99: begin
! 100: -- Append_Diff(res,res_last,d2); -- be aware of duplicates !
! 101: Append(res,res_last,d2); -- be aware of duplicates !
! 102: end;
! 103: tmp := Tail_Of(tmp);
! 104: end loop;
! 105: return res;
! 106: end Reduce;
! 107:
! 108: procedure Reduce ( l : in out List; i : in integer ) is
! 109:
! 110: res : List := Reduce(l,i);
! 111:
! 112: begin
! 113: Copy(res,l);
! 114: end Reduce;
! 115:
! 116: function Insert ( l : List; i,a : integer ) return List is
! 117:
! 118: tmp,res,res_last : List;
! 119:
! 120: begin
! 121: tmp := l;
! 122: while not Is_Null(tmp) loop
! 123: declare
! 124: d1 : Link_to_Vector := Head_Of(tmp);
! 125: d2 : Link_to_Vector := Insert(d1,i,a);
! 126: begin
! 127: Append(res,res_last,d2);
! 128: end;
! 129: tmp := Tail_Of(tmp);
! 130: end loop;
! 131: return res;
! 132: end Insert;
! 133:
! 134: procedure Insert ( l : in out List; i,a : in integer ) is
! 135:
! 136: res : List := Insert(l,i,a);
! 137:
! 138: begin
! 139: Deep_Clear(l);
! 140: l := res;
! 141: end Insert;
! 142:
! 143: function Transform_and_Reduce ( t : Transfo; i : integer; l : List )
! 144: return List is
! 145: tmp,res,res_last : List;
! 146:
! 147: begin
! 148: tmp := l;
! 149: while not Is_Null(tmp) loop
! 150: declare
! 151: d : Link_to_Vector := Head_Of(tmp);
! 152: td : Vector(d'range) := t*d.all;
! 153: dr : Link_to_Vector := new Vector'(Reduce(td,i));
! 154: begin
! 155: Append(res,res_last,dr);
! 156: end;
! 157: tmp := Tail_Of(tmp);
! 158: end loop;
! 159: return res;
! 160: end Transform_and_Reduce;
! 161:
! 162: procedure Transform_and_Reduce ( t : in Transfo; i : in integer;
! 163: l : in out List ) is
! 164:
! 165: res : List := Transform_and_Reduce(t,i,l);
! 166:
! 167: begin
! 168: Deep_Clear(l);
! 169: l := res;
! 170: end Transform_and_Reduce;
! 171:
! 172: function Insert_and_Transform ( l : List; i,a : integer; t : Transfo )
! 173: return List is
! 174:
! 175: tmp,res,res_last : List;
! 176:
! 177: begin
! 178: tmp := l;
! 179: while not Is_Null(tmp) loop
! 180: declare
! 181: d : Link_to_Vector := Insert_and_Transform(Head_Of(tmp),i,a,t);
! 182: begin
! 183: Append(res,res_last,d);
! 184: end;
! 185: tmp := Tail_Of(tmp);
! 186: end loop;
! 187: return res;
! 188: end Insert_and_Transform;
! 189:
! 190: procedure Insert_and_Transform
! 191: ( l : in out List; i,a : in integer; t : in Transfo ) is
! 192:
! 193: res : List := Insert_and_Transform(l,i,a,t);
! 194:
! 195: begin
! 196: Deep_Clear(l);
! 197: l := res;
! 198: end Insert_and_Transform;
! 199:
! 200: end Transforming_Integer_Vector_Lists;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to transforming_integer_vector_lists.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift