From: Timofei Shatrov
Subject: A fun problem I made up
Date: 
Message-ID: <4357e803.22851513@news.readfreenews.net>
This is a problem that some might find interesting.

PLUS programming language is a simplistic programming language with no
redeeming features. The program consists of some space separated
statements of a form "function argument" where both function and
arguments are bunch of pluses. Three functions are available:

+ symbol - prints the symbol's contents
++ symbol - adds + to the end of symbol's value
+++ symbol - adds space to the end of symbol's value

the symbol's names of course consist only of pluses. The problem is to
find a quine in that language (the program that prints itself).

The task is to write a program (in CL of course - or maybe some other
language) that constructs the quine. The result may be pretty long but
I'm almost sure it exists.

A simple interpreter of the language follows (use repl+ for interactive
prompt or eval+ for non-interactive evaluation):

(defparameter *symbol-hash* (make-hash-table :test #'equal))
(defparameter *function-hash* (make-hash-table :test #'equal))

(defun read+ (str)
  (assert (loop for x across str always (char= x #\+)))
  (or (gethash (length str) *symbol-hash*) ""))

(defun (setf read+) (value str)
  (assert (loop for x across str always (char= x #\+)))
  (setf (gethash (length str) *symbol-hash*) value))      

(defun init+ ()
  (setf *symbol-hash* (make-hash-table :test #'equal)
	*function-hash* (make-hash-table :test #'equal)
        (gethash 1 *function-hash*) 
	(lambda (str) (format t "~a" (read+ str)))
	(gethash 2 *function-hash*)
	(lambda (str) (setf (read+ str)
			    (concatenate 'string (read+ str) "+")))
	(gethash 3 *function-hash*)
	(lambda (str) (setf (read+ str)
			    (concatenate 'string (read+ str) " ")))))

(defun str+ (n)
  (make-string n :initial-element #\+))

(defun fcall+ (fun arg)
  (funcall (gethash fun *function-hash*) arg))

(defun eval+ (str)
  (loop with z = 0
	with fun = nil
	for x across str
	do (case x
	     (#\Space (unless (zerop z)
			(if fun 
			    (progn (fcall+ fun (str+ z)) 
				   (setf fun nil z 0))
			    (setf fun z z 0))))
	     (#\+ (incf z)))
	finally (unless (zerop z)
		  (if fun
		      (fcall+ fun (str+ z))
		      (error "Invalid program")))))

(defun repl+ ()
  (init+)
  (loop (fresh-line) (princ "PLUS>>") (eval+ (read-line))))


-- 
|a\o/r|,-------------.,---------- Timofei Shatrov aka Grue ------------.
| m"a ||FC AMKAR PERM|| mail: grue at mail.ru  http://grue3.tripod.com |
|  k  ||  PWNZ J00   || Kingdom of Loathing: Grue3 lvl 18 Seal Clubber |
`-----'`-------------'`-------------------------------------------[4*72]