Return to trees_of_vectors.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Implift

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;