From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: *
X-Spam-Status: No, score=1.9 required=5.0 tests=BAYES_50,INVALID_DATE,
	MSGID_SHORT,WEIRD_QUOTING autolearn=no autolearn_force=no version=3.4.4
Path: utzoo!utgpu!news-server.csri.toronto.edu!rutgers!rochester!cornell!oravax!klapper
From: klapper@oravax.UUCP (Carl Klapper)
Newsgroups: comp.lang.ada
Subject: self-writing ada programs
Keywords: ada,fixpoint
Message-ID: <1661@oravax.UUCP>
Date: 13 Sep 90 20:29:32 GMT
Distribution: usa
Organization: Odyssey Research Associates, Ithaca NY
List-Id: <comp.lang.ada>

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 |
+-----------------------------+--------------------------------------------+