The Ada Program: north.adb

  1 with Ada.Text_IO;
  2 use Ada;
  3 
  4 procedure North is
  5 
  6    --  generic data structure for lists
  7    generic
  8       type Element_Type is private;  -- The type of stack elements
  9    package List is
 10       type List_Type is private;
 11       Null_List : constant List_Type;
 12 
 13       --  Is the list empty?
 14       function Is_Null (List:  List_Type) return Boolean;
 15 
 16       --  Length of the list
 17       function Length (List: List_Type) return Natural;
 18 
 19       --  Add an element to the list
 20       function Cons (New_Element: Element_Type;
 21                      List       : List_Type) return List_Type;
 22 
 23       --  First element of the list
 24       function Car (List: List_Type) return Element_Type;
 25 
 26       --  Rest of the list (excluding the first element)
 27       function Cdr (List: List_Type) return List_Type;
 28 
 29       procedure Replaca (List: in out List_Type; Element: Element_Type);
 30 
 31    private
 32 
 33       type Node_Type;              -- Incomplete type
 34 
 35       type List_Type is access Node_Type;
 36 
 37       type Node_Type is
 38          record
 39             Info : Element_Type;   -- One item
 40             Next : List_Type;      -- The next node in the list
 41          end record;
 42 
 43       Null_List : constant List_Type := null;
 44 
 45    end List;
 46 
 47 
 48    --  generic data structure for lists
 49    package body List is
 50 
 51       function Is_Null (List: List_Type) return Boolean is
 52       begin
 53          return (List = null);
 54       end Is_Null;
 55 
 56       function Length (List: List_Type) return Natural is
 57          Copy: List_Type := List;
 58          L: Natural := 0;
 59       begin
 60          while Copy /= null loop
 61             Copy := Copy.Next;
 62             L := L + 1;
 63          end loop;
 64          return (L);
 65       end Length;
 66 
 67       function Cons (New_Element: Element_Type;
 68                      List       : List_Type) return List_Type is
 69       begin
 70          return (new Node_Type'(New_Element, List));
 71       end Cons;
 72 
 73       function Car (List: List_Type) return Element_Type is
 74       begin
 75          return (List.Info);
 76       end Car;
 77 
 78       procedure Replaca (List: in out List_Type; Element: Element_Type) is
 79       begin
 80          List.Info := Element;
 81       end Replaca;
 82 
 83       procedure Add (List: in out List_Type; Element: Element_Type) is
 84       begin
 85          List := Cons (Element, List);
 86       end Add;
 87 
 88       function Cdr (List: List_Type) return List_Type is
 89       begin
 90          return (List.Next);
 91       end Cdr;
 92 
 93       function Find (C: Element_Type; L: List_Type) return Boolean is
 94       begin
 95          if Is_Null (L) then
 96             return False;
 97          elsif Car (L) = C then  -- Which equality is used???
 98             return True;
 99          else
100             return Find (C, Cdr (L));
101          end if;
102       end Find;
103    end List;
104 
105    package City_Package is
106 
107       type City_Name is access String;
108 
109       function "=" (X,Y: City_Name) return Boolean;
110 
111       procedure Get (X,Y: out City_Name);
112 
113       procedure Put (X,Y: City_Name;
114                      B:String:="";
115                      M:String:=" is south of ";
116                      E:String:="."              );
117 
118    end City_Package;
119 
120    package body City_Package is
121 
122       function "=" (X,Y: City_Name) return Boolean is
123       begin
124          return X.all=Y.all;
125       end "=";
126 
127       procedure Get (X,Y: out City_Name) is
128          Buffer: String (1..100);
129          First, Last, Length: Natural;
130       begin
131          Text_IO.Get_Line (Buffer, Length);
132          First := Buffer'First;
133          while Buffer(First)=' ' loop
134             First:=First+1;
135          end loop;
136          Last := First + 1;
137          while Last<=Length and then Buffer(Last)/=' ' loop
138             Last:=Last+1;
139          end loop;
140          X := new String' (Buffer(First..Last-1));
141          First := Last+1;
142          while First<=Length and then Buffer(First)=' ' loop
143             First:=First+1;
144          end loop;
145          Last := First + 1;
146          while Last<=Length and then Buffer(Last)/=' ' loop
147             Last:=Last+1;
148          end loop;
149          Y := new String' (Buffer(First..Last-1));
150       end Get;
151 
152       procedure Put (X,Y: City_Name;
153                      B:String:="";
154                      M:String:=" is south of ";
155                      E:String:="."              ) is
156       begin
157          Text_IO.Put (B);
158          Text_IO.Put (X.all);
159          Text_IO.Put (M);
160          Text_IO.Put (Y.all);
161          Text_IO.Put_Line (E);
162       end Put;
163 
164    end City_Package;
165 
166    use City_Package;
167    package City_List_Package is new List (City_Name);
168    use City_List_Package;
169    subtype NorthernCities is City_List_Package.List_Type;
170 
171    function Find (C : City_Name;  L :  NorthernCities) return Boolean is
172    begin
173       if Is_Null (L) then
174          return False;
175       elsif Car (L) = C then
176          return True;
177       else
178          return Find (C, Cdr (L));
179       end if;
180    end Find;
181 
182    type T is record
183       City : City_Name := null;           -- southern terminus
184       List : NorthernCities := Null_List; -- list of nothern cities
185    end record;
186 
187    package Record_List_Package is new List (T);  use Record_List_Package;
188    subtype Graph is Record_List_Package.List_Type;
189 
190    All_Cities : Graph;
191 
192    --  Add a southern terminus, if not there already
193 
194    procedure Add (C : City_Name) is
195       R : T := (C, City_List_Package.Null_List);
196       L : Graph := All_Cities;
197    begin
198       if Is_Null (All_Cities) then
199          All_Cities := Cons (R, All_Cities);
200       else
201          loop
202             if Car (L).City = C then
203                return;
204             end if;
205             exit when Is_Null (Cdr (L));
206             L := Cdr (L);
207          end loop;
208          All_Cities := Cons (R, All_Cities);
209       end if;
210    end Add;
211 
212    procedure Add_North (C, N : City_Name) is
213       L : Graph := All_Cities;
214       M : Graph := Record_List_Package.Null_List;
215       X : T;
216    begin
217       while not (Is_Null (L)) loop
218          X := Car (L);
219          if (Car (L).City = C and then not Find (N, Car (L).List)) then
220             X.List := Cons (N, X.List);
221          end if;
222          M := Cons (X, M);
223          L := Cdr (L);
224       end loop;
225       All_Cities := M;
226    end Add_North;
227 
228 
229    function Is_South (C, N : City_Name) return Boolean is
230       L : Graph := All_Cities;
231       function Is_South (X : NorthernCities) return Boolean is
232       begin
233          if Is_Null (X) then
234             return False;
235          elsif Car (X) = N then
236             return True;
237          else
238             return Is_South (Car (X), N) or else Is_South (Cdr (X));
239          end if;
240       end Is_South;
241    begin
242       while not (Is_Null (L)) loop
243          if Car (L).City = C then
244             return Is_South (Car (L).List);
245          end if;
246          L := Cdr (L);
247       end loop;
248       return False;  -- perhaps city not in the list
249    end Is_South;
250 
251    procedure Relate (C, N : City_Name) is
252       Msg : constant String := "The relative position of ";
253    begin
254       if Is_South (C, N) then
255          Put (C, N);
256       elsif Is_South (N, C) then
257          Put (C, N, M => " is north of ");
258       else
259          Put (C, N, B => Msg, M => " and ", E => " is unknown.");
260       end if;
261    end Relate;
262 
263    City1, City2 : City_Name;
264 
265 begin
266 
267    --  build graph
268    loop
269       Get (City1, City2);
270       exit when City1.all = "#";
271       Add (City1);
272       Add_North (City1, City2);
273    end loop;
274 
275    --  search graph
276    loop
277       Get (City1, City2);
278       exit when City1.all = "#";
279       Relate (City1, City2);
280    end loop;
281 
282 end North;