Return to trees_of_vectors_io.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_io.adb, Revision 1.1.1.1

1.1       maekawa     1: with integer_io;                         use integer_io;
                      2: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
                      3: with Standard_Integer_Vectors_io;        use Standard_Integer_Vectors_io;
                      4:
                      5: package body Trees_of_Vectors_io is
                      6:
                      7: -- INTERNAL STATES :
                      8:
                      9:   max : constant natural := 20;
                     10:   tokens : Vector(1..max);
                     11:   done : boolean;
                     12:   cnt : natural;
                     13:
                     14: -- READ OPERATIONS :
                     15:
                     16:   procedure get ( n : in natural; tv : in out Tree_of_Vectors ) is
                     17:   begin
                     18:     get(Standard_Input,n,tv);
                     19:   end get;
                     20:
                     21:   procedure get ( file : in file_type;
                     22:                   n : in natural; tv : in out Tree_of_Vectors ) is
                     23:   begin
                     24:     if done
                     25:      then cnt := 0;
                     26:           while not END_OF_LINE(file) loop
                     27:             cnt := cnt + 1;
                     28:             get(file,tokens(cnt));
                     29:           end loop;
                     30:          if cnt = 0
                     31:           then done := true;
                     32:           else done := false;
                     33:           end if;
                     34:     end if;
                     35:     if not done
                     36:      then if (cnt = 0) or (cnt > n)
                     37:            then null;
                     38:            elsif cnt = n
                     39:                then declare
                     40:                       nd : node;
                     41:                     begin
                     42:                       nd.d := new Vector'(tokens(1..cnt));
                     43:                       done := true;
                     44:                       skip_line(file);
                     45:                       nd.ltv := new Tree_of_Vectors;
                     46:                       get(file,n-1,nd.ltv.all);
                     47:                       if Is_Null(nd.ltv.all)
                     48:                        then Clear(nd.ltv);
                     49:                             nd.ltv := null;
                     50:                       end if;
                     51:                      Construct(nd,tv);
                     52:                      get(file,n,tv);
                     53:                     end;
                     54:                else get(file,n-1,tv);
                     55:           end if;
                     56:     end if;
                     57:   end get;
                     58:
                     59: -- WRITE OPERATIONS :
                     60:
                     61:   procedure put ( tv : in Tree_of_Vectors ) is
                     62:   begin
                     63:     put(Standard_Output,tv);
                     64:     new_line;
                     65:   end put;
                     66:
                     67:   procedure put2 ( file : in file_type; tv : in Tree_of_Vectors );
                     68:
                     69:   procedure put ( file : in file_type; nd : in node ) is
                     70:   begin
                     71:     put(file,nd.d); new_line(file);
                     72:     if not (nd.ltv = null) and then not Is_Null(nd.ltv.all)
                     73:      then put2(file,nd.ltv.all);
                     74:     end if;
                     75:   end put;
                     76:
                     77:   procedure put2 ( file : in file_type; tv : in Tree_of_Vectors ) is
                     78:
                     79:     tmp : Tree_of_Vectors := tv;
                     80:
                     81:     procedure put_Node ( nd : in node; cont : out boolean ) is
                     82:     begin
                     83:       put(file,nd.d); new_line(file);
                     84:       if not (nd.ltv = null) and then not Is_Null(nd.ltv.all)
                     85:        then put2(file,nd.ltv.all);
                     86:       end if;
                     87:       cont := true;
                     88:     end put_Node;
                     89:
                     90:    -- procedure put_Nodes is new Iterator ( Process => put_Node );
                     91:
                     92:   begin
                     93:    -- put_Nodes(tv);
                     94:     while not Is_Null(tmp) loop
                     95:       put(file,Head_Of(tmp));
                     96:       tmp := Tail_Of(tmp);
                     97:     end loop;
                     98:   end put2;
                     99:
                    100:   procedure put ( file : in file_type; tv : in Tree_of_Vectors ) is
                    101:   begin
                    102:     put2(file,tv);
                    103:     new_line(file);
                    104:   end put;
                    105:
                    106: -- PACKAGE INITIALIZATION :
                    107:
                    108: begin
                    109:   done := true;
                    110: end Trees_of_Vectors_io;