klapper@oravax.UUCP (Carl Klapper) (09/14/90)
Just for fun, I solved the old "write a program which writes out its source"
puzzle for Ada, with the program shown below. Has anyone come up with
a substantially shorter or different such program, using only text_io?
[Exclude the program resulting from putting an analogous program on one
(or a few) much less readable line, shorter function names, etc..]
------------------------------- Clip here ------------------------------------
with text_io; use text_io;
procedure write_myself is
type my_string is access string;
s : array (1 .. 32) of my_string;
procedure positive_put (str : string) is
begin
put(str(2..str'last));
end positive_put;
begin
s(1) := new string'("with text_io; use text_io;");
s(2) := new string'("procedure write_myself is");
s(3) := new string'(" ");
s(4) := new string'("type my_string is access string;");
s(5) := new string'("s : array (1 .. 32) of my_string;");
s(6) := new string'("procedure positive_put (str : string) is");
s(7) := new string'(" begin");
s(8) := new string'(" put(str(2..str'last));");
s(9) := new string'(" end positive_put;");
s(10) := new string'("""");
s(11) := new string'(");");
s(12) := new string'("s(");
s(13) := new string'(") := new string'(");
s(14) := new string'(" put(s(1).all);new_line;");
s(15) := new string'(" put(s(2).all);new_line;");
s(16) := new string'(" put(s(3).all);put(s(4).all);new_line;");
s(17) := new string'(" put(s(3).all);put(s(5).all);new_line;");
s(18) := new string'(" put(s(3).all);put(s(6).all);new_line;");
s(19) := new string'(" put(s(3).all);put(s(7).all);new_line;");
s(20) := new string'(" put(s(3).all);put(s(8).all);new_line;");
s(21) := new string'(" put(s(3).all);put(s(9).all);new_line;");
s(22) := new string'(" put(s(7).all);new_line;");
s(23) := new string'(" for I in 1..32 loop");
s(24) := new string'(" put(s(3).all);put(s(12).all);positive_put(positive'image(I));");
s(25) := new string'(" put(s(13).all);put(s(10).all);put(s(I).all);");
s(26) := new string'(" if (I=10) then put(s(I).all); else null; end if;");
s(27) := new string'(" put(s(10).all);put(s(11).all);new_line;");
s(28) := new string'(" end loop;");
s(29) := new string'(" for I in 14..32 loop");
s(30) := new string'(" put(s(I).all);new_line;");
s(31) := new string'(" end loop;");
s(32) := new string'(" end write_myself;");
put(s(1).all);new_line;
put(s(2).all);new_line;
put(s(3).all);put(s(4).all);new_line;
put(s(3).all);put(s(5).all);new_line;
put(s(3).all);put(s(6).all);new_line;
put(s(3).all);put(s(7).all);new_line;
put(s(3).all);put(s(8).all);new_line;
put(s(3).all);put(s(9).all);new_line;
put(s(7).all);new_line;
for I in 1..32 loop
put(s(3).all);put(s(12).all);positive_put(positive'image(I));
put(s(13).all);put(s(10).all);put(s(I).all);
if (I=10) then put(s(I).all); else null; end if;
put(s(10).all);put(s(11).all);new_line;
end loop;
for I in 14..32 loop
put(s(I).all);new_line;
end loop;
end write_myself;
------------------------------- Clip here ------------------------------------
+-----------------------------+--------------------------------------------+
| Real urbanites don't buy | Carl Klapper |
| things. They buy service. | Odyssey Research Associates, Inc. |
| | 301A Harris B. Dates Drive |
| A kitchen's place is | Ithaca, NY 14850 |
| in the restaurant. | (607) 277-2020 |
| | klapper%oravax.uucp@cu-arpa.cs.cornell.edu |
+-----------------------------+--------------------------------------------+