home *** CD-ROM | disk | FTP | other *** search
/ Chip 1995 March / CHIP3.mdf / programm / prog4 / sortlist.ada < prev    next >
Encoding:
Text File  |  1991-07-01  |  3.7 KB  |  130 lines
  1.                                        -- Chapter 23 - Program 2
  2. with Text_IO, Unchecked_Deallocation;
  3. use Text_IO;
  4.  
  5. procedure SortList is
  6.  
  7.    package Int_IO is new Text_IO.Integer_IO(INTEGER);
  8.    use Int_IO;
  9.  
  10.    Data_String : constant STRING := "This tests ADA";
  11.  
  12.    type CHAR_REC;                 -- Incomplete declaration
  13.  
  14.    type CHAR_REC_POINT is access CHAR_REC;
  15.  
  16.    type CHAR_REC is               -- Complete declaration
  17.       record
  18.          One_Letter : CHARACTER;
  19.          Next_Rec   : CHAR_REC_POINT;
  20.       end record;
  21.  
  22.    Start : CHAR_REC_POINT;        -- Always points to start of list
  23.    Last  : CHAR_REC_POINT;        -- Points to the end of the list
  24.  
  25.    pragma CONTROLLED(CHAR_REC_POINT);
  26.  
  27.    procedure Free is new Unchecked_Deallocation(CHAR_REC,
  28.                                                    CHAR_REC_POINT);
  29.  
  30.    procedure Traverse_List(Starting_Point : CHAR_REC_POINT) is
  31.    Temp : CHAR_REC_POINT;         -- Moves through the list
  32.    begin
  33.       Put("In traverse routine.  --->");
  34.       Temp := Starting_Point;
  35.       if Temp = null then
  36.          Put("No data in list.");
  37.       else
  38.          loop
  39.             Put(Temp.One_Letter);
  40.             Temp := Temp.Next_Rec;
  41.             if Temp = null then exit; end if;
  42.          end loop;
  43.       end if;
  44.       New_Line;
  45.    end Traverse_List;
  46.  
  47.    procedure Store_Character(In_Char : CHARACTER) is
  48.    Temp : CHAR_REC_POINT;         -- Moves through the list
  49.  
  50.       procedure Locate_And_Store is
  51.       Search : CHAR_REC_POINT;
  52.       Prior  : CHAR_REC_POINT;
  53.       begin
  54.          Search := Start;
  55.          while In_Char > Search.One_Letter loop
  56.             Prior := Search;
  57.             Search := Search.Next_Rec;
  58.             if Search = null then exit; end if;
  59.          end loop;
  60.          if Search = Start then   -- New character at head of list
  61.             Temp.Next_Rec := Start;
  62.             Start := Temp;
  63.          elsif Search = null then -- New character at tail of list
  64.             Last.Next_Rec := Temp;
  65.             Last := Temp;
  66.          else                     -- New character within list
  67.             Temp.Next_Rec := Search;
  68.             Prior.Next_Rec := Temp;
  69.          end if;
  70.       end Locate_And_Store;
  71.  
  72.    begin
  73.       Temp := new CHAR_REC;
  74.          Temp.One_Letter := In_Char; -- New record is now defined
  75.                                      -- The system sets Next_Rec
  76.                                      -- to the value of null
  77.       if Start = null then
  78.          Start := Temp;
  79.          Last := Temp;
  80.       else
  81.          Locate_And_Store;
  82.       end if;
  83.       Traverse_List(Start);
  84.    end Store_Character;
  85.  
  86. begin
  87.             -- Store the characters in Data_String in a linked list
  88.    for Index in Data_String'RANGE loop
  89.       Store_Character(Data_String(Index));
  90.    end loop;
  91.  
  92.             -- Traverse the final list
  93.    New_Line;
  94.    Put_Line("Now for the final traversal.");
  95.    Traverse_List(Start);
  96.  
  97.             -- Deallocate the list now
  98.    loop
  99.       exit when Start = null;
  100.       Last := Start.Next_Rec;
  101.       Free(Start);
  102.       Start := Last;
  103.    end loop;
  104.  
  105. end SortList;
  106.  
  107.  
  108.  
  109.  
  110. -- Result of execution
  111. --
  112. -- In traverse routine.  --->T
  113. -- In traverse routine.  --->Th
  114. -- In traverse routine.  --->Thi
  115. -- In traverse routine.  --->This
  116. -- In traverse routine.  ---> This
  117. -- In traverse routine.  ---> Thist
  118. -- In traverse routine.  ---> Tehist
  119. -- In traverse routine.  ---> Tehisst
  120. -- In traverse routine.  ---> Tehisstt
  121. -- In traverse routine.  ---> Tehissstt
  122. -- In traverse routine.  --->  Tehissstt
  123. -- In traverse routine.  --->  ATehissstt
  124. -- In traverse routine.  --->  ADTehissstt
  125. -- In traverse routine.  --->  AADTehissstt
  126. --
  127. -- Now for the final traversal.
  128. -- In traverse routine.  --->  AADTehissstt
  129.  
  130.