$ ADA TACCESS5
NYU ANSI-Ada/ED 1.1(11-Apr-83)           WED  29 FEB 84  15:41:22   PAGE     1
ADAfile:	TACCESS5.ADA

    1   with TEXT_IO ; use TEXT_IO ;
    2   procedure MAIN is  -- NOW, change  FIND function from a recursive
    3                      --      to an iterative algorithm
    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         elsif NAME > T.NAME then
   48           INSERT(T.RIGHT,NAME,PHONE) ;
   49         else   -- name already in phone book, just update phone number
   50           T.PHONE := PHONE ;
   51         end if ;
   52       end if ;
   53     end INSERT ;
   54
   55
   56     function FIND(T : NODE_PTR ; NAME : STRING ) return STRING is
   57       PHONE : STRING(1..2) := "**" ; -- default ** for no find
   58       P     : NODE_PTR     := T ;    -- initial node pointer
   59     begin



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

  No translation errors detected
  Translation time: 147 seconds

  Binding time: 5.6 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: 108 seconds
  I-code statements executed: 675