Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/integer_vectors_utilities.adb, Revision 1.1
1.1 ! maekawa 1: package body Integer_Vectors_Utilities is
! 2:
! 3: function Pivot ( v : Vector ) return integer is
! 4: begin
! 5: for i in v'range loop
! 6: if v(i) /= 0
! 7: then return i;
! 8: end if;
! 9: end loop;
! 10: return (v'last + 1);
! 11: end Pivot;
! 12:
! 13: function Pivot ( v : Link_to_Vector ) return integer is
! 14: begin
! 15: if v = null
! 16: then return 0;
! 17: else return Pivot(v.all);
! 18: end if;
! 19: end Pivot;
! 20:
! 21: function Reduce ( v : Vector; i : integer ) return Vector is
! 22:
! 23: res : Vector(v'first..(v'last-1));
! 24:
! 25: begin
! 26: for j in res'range loop
! 27: if j < i
! 28: then res(j) := v(j);
! 29: else res(j) := v(j+1);
! 30: end if;
! 31: end loop;
! 32: return res;
! 33: end Reduce;
! 34:
! 35: function Reduce ( v : Link_to_Vector; i : integer ) return Link_to_Vector is
! 36: begin
! 37: if v = null
! 38: then return v;
! 39: else declare
! 40: res : Link_to_Vector := new Vector'(Reduce(v.all,i));
! 41: begin
! 42: return res;
! 43: end;
! 44: end if;
! 45: end Reduce;
! 46:
! 47: procedure Reduce ( v : in out Link_to_Vector; i : in integer ) is
! 48: begin
! 49: if v /= null
! 50: then declare
! 51: res : constant Vector := Reduce(v.all,i);
! 52: begin
! 53: Clear(v);
! 54: v := new Vector'(res);
! 55: end;
! 56: end if;
! 57: end Reduce;
! 58:
! 59: function Insert ( v : Vector; i,a : integer ) return Vector is
! 60:
! 61: res : Vector(v'first..(v'last+1));
! 62:
! 63: begin
! 64: for j in res'first..(i-1) loop
! 65: res(j) := v(j);
! 66: end loop;
! 67: res(i) := a;
! 68: for j in (i+1)..res'last loop
! 69: res(j) := v(j-1);
! 70: end loop;
! 71: return res;
! 72: end Insert;
! 73:
! 74: function Insert ( v : Link_to_Vector; i,a : integer )
! 75: return Link_to_Vector is
! 76:
! 77: res : Link_to_Vector;
! 78:
! 79: begin
! 80: if v = null
! 81: then res := new Vector'(i..i => a);
! 82: else res := new Vector'(Insert(v.all,i,a));
! 83: end if;
! 84: return res;
! 85: end Insert;
! 86:
! 87: procedure Insert ( v : in out Link_to_Vector; i,a : in integer ) is
! 88: begin
! 89: if v /= null
! 90: then declare
! 91: res : constant Vector := Insert(v.all,i,a);
! 92: begin
! 93: Clear(v);
! 94: v := new Vector'(res);
! 95: end;
! 96: end if;
! 97: end Insert;
! 98:
! 99: function Insert_and_Transform
! 100: ( v : Vector; i,a : integer; t : Transfo ) return Vector is
! 101:
! 102: res : Vector(v'first..v'last+1) := Insert(v,i,a);
! 103:
! 104: begin
! 105: Apply(t,res);
! 106: return res;
! 107: end Insert_and_Transform;
! 108:
! 109: procedure Insert_and_Transform
! 110: ( v : in out Link_to_Vector; i,a : in integer; t : in Transfo ) is
! 111: res : Link_to_Vector;
! 112: begin
! 113: res := Insert_and_Transform(v,i,a,t);
! 114: Clear(v);
! 115: v := res;
! 116: end Insert_and_Transform;
! 117:
! 118: function Insert_and_Transform
! 119: ( v : Link_to_Vector; i,a : integer; t : Transfo )
! 120: return Link_to_Vector is
! 121:
! 122: res : Link_to_Vector;
! 123:
! 124: begin
! 125: if v = null
! 126: then res := Insert(v,i,a);
! 127: Apply(t,res.all);
! 128: else res := new Vector'(Insert_and_Transform(v.all,i,a,t));
! 129: end if;
! 130: return res;
! 131: end Insert_and_Transform;
! 132:
! 133: end Integer_Vectors_Utilities;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>