ka@cs.washington.edu (Kenneth Almquist) (03/22/90)
Is your Ada compiler smarter than you? None of the following pieces
of code will compile. Your compiler can find the errors; can you?
One hint: to the best of my knowledge all of these programs follow
the BNF syntax for Ada given in the language reference manual.
Kenneth Almquist
P.S. Thanks to the people who responded to my last posting.
Puzzle 1:
-- The package main_routine defines a generic main routine which will
-- parse the command line arguments of simple UNIX commands. It calls
-- the process_option routine when it encounters a command line option,
-- and process_file for each argument following the options. If there
-- are no arguments following the options, it calls process_file with
-- the string "-", indicating that the standard input should be read.
-- The option_spec array is indexed by the possible option characters,
-- and indicates whether the option is illegal and whether it is followed
-- by a string argument or not.
package main_routine is
type option_class is (illegal, simple, string_arg);
type option_class_array is array(character) of option_class;
generic
with procedure process_file(name: string);
with procedure process_option(opt: character; arg: string);
option_spec: option_class_array;
procedure main;
end main_routine;
package grep_pack is
procedure option(opt: character; arg: string);
procedure grep(name: string);
end grep_pack;
with main_routine, grep_pack;
procedure grep is new main_routine.main(grep_pack.grep, grep_pack.option,
(others => main_routine.illegal));
Puzzle 2:
package main_routine is
type option_class is (illegal, simple, string_arg);
type option_class_array is array(character) of option_class;
generic
with procedure process_file(name: string);
with procedure process_option(opt: character; arg: string);
option_spec: option_class_array;
procedure main;
end main_routine;
package print_file is
procedure process_option(opt: character; arg: string);
procedure copyfile(name: string);
end print_file;
with main_routine, print_file;
use main_routine, print_file;
procedure cat is new main(copyfile, process_option,
('s' => simple, 'u' => simple, others => illegal));
Puzzle 3:
package xyz is end xyz;
package body xyz is
type integer_array is array(positive range <>) of integer;
type character_array is array(positive range <>) of character;
procedure p(a: integer_array) is
begin
null;
end p;
procedure p(a: character_array) is
begin
null;
end p;
begin -- xyz
p((1, 2, 3));
p("abc");
end xyz;
Puzzle 4:
generic
type elem is private;
type elem_array is array(integer range <>) of elem;
with function "<"(left, right: elem) return boolean;
procedure sort(a: in out elem_array);
procedure sort(a: in out elem_array) is
e: elem;
j: integer;
begin
for i in a'first .. a'last - 1 loop
e := a(i);
j := i - 1;
while j >= a'first and then e < a(j) loop
a(j + 1) := a(j);
j := j - 1;
end loop;
a(j + 1) := e;
end loop;
end sort;
with text_io, sort;
use text_io;
procedure test_sort is
type integer_array is array(integer range <>) of integer;
a: integer_array(1..9) := (4, 2, 7, 3, 9, 1, 6, 8, 5);
procedure sort is new sort(integer, integer_array, "<");
package int_io is new integer_io(integer); use int_io;
begin
sort(a);
for i in a'first .. a'last loop
put(a(i)); new_line;
end loop;
end test_sort;
Puzzle 5:
package command_arguments is
function arg(i: positive) return string;
function nargs return natural;
end command_arguments;
procedure process_file(fname: string) is
begin
raise program_error; -- procedure not yet written
end process_file;
with command_arguments, process_file, text_io;
use command_arguments, text_io;
procedure main is
-- function to convert a character to lower case:
function to_lower(c: character) return character is
begin
if c in 'A' .. 'Z' then
return character'val(character'pos(c)
- character'pos('A') + character'pos('a'));
else
return c;
end if;
end to_lower;
begin -- main
for i in 1..nargs loop
declare
fname: string := arg(i);
begin
for j in fname'first .. fname'last loop -- convert fname to
fname(j) := to_lower(fname(j)); -- lower case
end loop;
process_file(fname);
end;
end loop;
end main;
Puzzle 6:
generic
type elem is private;
package fifo is
type fifo is private;
procedure insert(e: in elem; f: in out fifo);
procedure remove(e: out elem; f: in out fifo);
private
type fifo;
type fifo_ptr is access fifo;
type fifo is record
next: fifo_ptr;
prev: fifo_ptr;
e: elem;
end record;
end fifo;
Have fun!