The Ada Program: north.adb
1 with Ada.Text_IO;
2 use Ada;
3
4 procedure North is
5
6
7 generic
8 type Element_Type is private;
9 package List is
10 type List_Type is private;
11 Null_List : constant List_Type;
12
13
14 function Is_Null (List: List_Type) return Boolean;
15
16
17 function Length (List: List_Type) return Natural;
18
19
20 function Cons (New_Element: Element_Type;
21 List : List_Type) return List_Type;
22
23
24 function Car (List: List_Type) return Element_Type;
25
26
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;
34
35 type List_Type is access Node_Type;
36
37 type Node_Type is
38 record
39 Info : Element_Type;
40 Next : List_Type;
41 end record;
42
43 Null_List : constant List_Type := null;
44
45 end List;
46
47
48
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
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;
184 List : NorthernCities := Null_List;
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
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;
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
268 loop
269 Get (City1, City2);
270 exit when City1.all = "#";
271 Add (City1);
272 Add_North (City1, City2);
273 end loop;
274
275
276 loop
277 Get (City1, City2);
278 exit when City1.all = "#";
279 Relate (City1, City2);
280 end loop;
281
282 end North;