$ ADA TACCESS4
NYU ANSI-Ada/ED 1.1(11-Apr-83)           TUE  28 FEB 84  00:33:29   PAGE     1
ADAfile:	TACCESS4.ADA


    1   with TEXT_IO ; use TEXT_IO ;
    2   procedure MAIN is  -- NOW, add a  FIND function that takes a
    3                      --      name and returns a phone number
    4
    5     type NODE ; -- just introduce type name
    6     type NODE_PTR is access NODE ; -- define an access type
    7                                    -- ie the type of a pointer
    8     type NODE is  -- now, really define the type NODE
    9       record
   10         BF    : INTEGER      ; -- balance factor for later use
   11         LEFT  : NODE_PTR     ; -- this records predecessor
   12         RIGHT : NODE_PTR     ; -- this records sucessor
   13         NAME  : STRING(1..2) ; -- data, the "sort" key
   14         PHONE : STRING(1..2) ; -- more tag along data
   15       end record ;
   16
   17     ROOT_PTR   : NODE_PTR := null ;   -- initially null
   18     MY_NAME  : STRING(1..2) ;
   19     MY_PHONE : STRING(1..2) ;
   20
   21     DEPTH : INTEGER := 1 ; -- indentation depth
   22
   23     procedure OUTPUT(T : NODE_PTR ) is
   24       procedure INDENT is
   25       begin
   26         for I in 1..DEPTH loop
   27           PUT("    ") ;
   28         end loop ;
   29       end INDENT ;
   30     begin
   31       DEPTH := DEPTH + 1 ;  -- count depth "down" upon entry
   32       if T /= null then
   33         OUTPUT(T.LEFT) ;
   34         INDENT ; PUT(T.NAME) ; PUT_LINE(T.PHONE) ;
   35         OUTPUT(T.RIGHT) ;
   36       end if ;
   37       DEPTH := DEPTH - 1 ;  -- count depth "up" upon exit
   38     end OUTPUT ;
   39
   40     procedure INSERT(T : in out NODE_PTR ; NAME,PHONE : STRING ) is
   41     begin
   42       if T = null then
   43         T := new NODE'(0, null, null, NAME, PHONE) ;
   44       else
   45         if NAME < T.NAME then
   46           INSERT(T.LEFT,NAME,PHONE) ;
   47         else
   48           INSERT(T.RIGHT,NAME,PHONE) ;
   49         end if ;
   50       end if ;
   51     end INSERT ;
   52
   53








   54     function FIND(T : NODE_PTR ; NAME : STRING ) return STRING is
   55       PHONE : STRING(1..2) := "**" ; -- default ** for no find
   56     begin
   57       if T /= null then          -- this stops search for "no find"
   58          if    NAME < T.NAME then
   59             PHONE := FIND(T.LEFT,NAME) ;  -- go looking left
   60          elsif NAME > T.NAME then
   61             PHONE := FIND(T.RIGHT,NAME) ; -- go looking right
   62          else
   63             PHONE := T.PHONE ;            -- found
   64          end if ;
   65       end if ;
   66       return PHONE ;
   67     end FIND ;
   68
   69
   70   begin
   71     PUT_LINE(" TREE INSERTION AND PRINTOUT") ;
   72     -- build a tree using the INSERT procedure
   73     INSERT(ROOT_PTR,"D ","4 ") ; -- initial node at root
   74       -- first tier
   75       INSERT(ROOT_PTR,"B ","2 ") ;
   76         -- replaces  LEFT_PTR := new NODE'(0, null, null, "B ", "2 ") ;
   77       INSERT(ROOT_PTR,"F ","6 ") ;
   78
   79         -- second tier
   80         INSERT(ROOT_PTR,"A ","1 ") ;
   81         INSERT(ROOT_PTR,"C ","3 ") ;
   82         INSERT(ROOT_PTR,"E ","5 ") ;
   83         INSERT(ROOT_PTR,"G ","7 ") ;
   84
   85     OUTPUT(ROOT_PTR) ; -- look at tree produced. The order of the tree
   86                        -- build was carefully planned to get a balanced
   87                        -- binary tree
   88
   89     MY_NAME  := "E " ;
   90     MY_PHONE := FIND(ROOT_PTR,MY_NAME) ;  -- test FIND function
   91     PUT_LINE( MY_NAME & " has a phone number " & MY_PHONE ) ;
   92     MY_PHONE := FIND(ROOT_PTR,"D ") ;     -- test FIND function on root
   93     PUT_LINE( "D " & " has a phone number " & MY_PHONE ) ;
   94     MY_PHONE := FIND(ROOT_PTR,"XX") ;     -- test FIND function on name
   95                                           -- not in directory
   96     PUT_LINE( "XX" & " has a phone number " & MY_PHONE ) ;
   97   end MAIN ;

  No translation errors detected
  Translation time: 138 seconds
  Binding time: 5.1 seconds
  Begin Ada execution

 TREE INSERTION AND PRINTOUT
                A 1 
            B 2 
                C 3 
        D 4 
                E 5 
            F 6 
                G 7 
E  has a phone number 5 
D  has a phone number 4 
XX has a phone number **

  Execution complete
  Execution time: 110 seconds
  I-code statements executed: 711