Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Implift/trees_of_vectors.adb, Revision 1.1.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>