Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/trees_of_vectors.adb, Revision 1.1
1.1 ! maekawa 1: with unchecked_deallocation;
! 2:
! 3: package body Trees_of_Vectors is
! 4:
! 5: -- SELECTORS :
! 6:
! 7: function Is_In ( tv : Tree_of_Vectors; v : Vector ) return boolean is
! 8:
! 9: tmp : Tree_of_Vectors;
! 10: d2 : Link_to_Vector;
! 11:
! 12: begin
! 13: tmp := tv;
! 14: while not Is_Null(tmp) loop
! 15: d2 := Head_Of(tmp).d;
! 16: if Equal(d2.all,v)
! 17: then return true;
! 18: else tmp := Tail_Of(tmp);
! 19: end if;
! 20: end loop;
! 21: return false;
! 22: end Is_In;
! 23:
! 24: function Is_In ( tv : Tree_of_Vectors; v : Link_to_Vector ) return boolean is
! 25: begin
! 26: if v /= null
! 27: then return Is_In(tv,v.all);
! 28: else return false;
! 29: end if;
! 30: end Is_In;
! 31:
! 32: procedure Iterator ( tv : in Tree_of_Vectors ) is
! 33:
! 34: tmp : Tree_of_Vectors;
! 35: cont : boolean;
! 36:
! 37: begin
! 38: tmp := tv;
! 39: while not Is_Null(tmp) loop
! 40: Process(Head_Of(tmp),cont);
! 41: exit when not cont;
! 42: tmp := Tail_Of(tmp);
! 43: end loop;
! 44: end Iterator;
! 45:
! 46: -- DESTRUCTORS :
! 47:
! 48: procedure Clear ( nd : in out node ) is
! 49: begin
! 50: Clear(nd.d);
! 51: Clear(nd.ltv);
! 52: end Clear;
! 53:
! 54: procedure Clear ( tv : in out Tree_of_Vectors ) is
! 55:
! 56: tmp : Tree_of_Vectors;
! 57:
! 58: begin
! 59: tmp := tv;
! 60: while not Is_Null(tmp) loop
! 61: declare
! 62: nd : node := Head_Of(tmp);
! 63: begin
! 64: Clear(nd);
! 65: end;
! 66: tmp := Tail_Of(tmp);
! 67: end loop;
! 68: Link_to_Vector_Trees.Clear(Link_to_Vector_Trees.List(tv));
! 69: end Clear;
! 70:
! 71: procedure Clear ( ltv : in out Link_to_Tree_of_Vectors ) is
! 72:
! 73: procedure free is new unchecked_deallocation(Tree_of_Vectors,
! 74: Link_to_Tree_of_Vectors);
! 75: begin
! 76: if not (ltv = null)
! 77: then Clear(ltv.all);
! 78: free(ltv);
! 79: end if;
! 80: end Clear;
! 81:
! 82: end Trees_of_Vectors;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>