[BACK]Return to trees_of_vectors_io.adb CVS log [TXT][DIR] 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     ! 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;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>