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>