;;;; -*- mode:lisp; coding:utf-8 -*-
;;;;****************************************************************************
;;;;FILE:               quine.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;    
;;;;    Quines are programs that output themselves.
;;;;    Three implementations in Common-Lisp.
;;;;    
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2003-12-29 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    Public Domain
;;;;    
;;;;    This software is in Public Domain.
;;;;    You're free to do with it as you please.
;;;;****************************************************************************


;; -------------------------------------------------------------------
;; QUINE-1 cheats  a little:  it works only  on clisp and on a
;; non-compiled function, retrieving the lambda-expression stored in
;; the  symbol-function slot of the symbol naming the function itself
;; (similar  to retriving the source of the program from the hard disk).

#+CLISP
(DEFUN QUINE-1 NIL
  (LET ((LEXP (FUNCTION-LAMBDA-EXPRESSION (SYMBOL-FUNCTION 'QUINE-1))))
    (FORMAT T "~S~%"
            `(DEFUN ,(SECOND (FOURTH LEXP)) ,(SECOND LEXP)
               ,@(CDDR (FOURTH LEXP))))))

;; -------------------------------------------------------------------
;; QUINE-2 is  nicer, but works by  generating a string  and using the
;; FORMAT  interpreter  (with  the  ~S  trick  to  generate  a  quoted
;; string...).

(DEFUN QUINE-2 NIL
  (LET ((SRC "(DEFUN QUINE-2 NIL (LET ((SRC ~S)) (FORMAT T SRC SRC)))"))
     (FORMAT t SRC SRC)))


;; QUINE-2S is like QUINE-2 but instead of producing its source as a string,
;; it returns it as a s-expression.

(DEFUN QUINE-2S NIL
  (LET ((SRC "(DEFUN QUINE-2S NIL
                (LET ((SRC ~S))
                  (READ-FROM-STRING (FORMAT NIL SRC SRC))))"))
    (READ-FROM-STRING (FORMAT nil SRC SRC))))


;; QUINE-2E is like QUINE-2S but instead of producing its source as its result
;; it redefines itself.

(DEFUN QUINE-2E NIL
  (LET ((SRC "(DEFUN QUINE-2E NIL
                (LET ((SRC ~S))
                  (EVAL (READ-FROM-STRING (FORMAT NIL SRC SRC)))))"))
    (eval (read-from-string (FORMAT nil SRC SRC)))))


;; -------------------------------------------------------------------
;; QUINE-3 generates and returns a new tree equal to the sexp defining
;; QUINE-3 itself.

(DEFUN QUINE-3 NIL
  (LABELS
    ((FIND-CAR
      (TOKEN TREE)
      (COND
       ((ATOM TREE) NIL)
       ((EQ TOKEN (CAR TREE)) TREE)
       (T (OR (FIND-CAR TOKEN (CAR TREE))
              (FIND-CAR TOKEN (CDR TREE)))))))
    (LET* ((SOURCE '(DEFUN QUINE-3 NIL
                      (LABELS
                        ((FIND-CAR
                          (TOKEN TREE)
                          (COND
                           ((ATOM TREE) NIL)
                           ((EQ TOKEN (CAR TREE)) TREE)
                           (T (OR (FIND-CAR TOKEN (CAR TREE))
                                  (FIND-CAR TOKEN (CDR TREE)))))))
                        (LET* ((SOURCE ':QUINE)
                               (QUINE-3 (COPY-TREE SOURCE)))
                          (SETF (CAR (FIND-CAR :QUINE QUINE-3)) SOURCE)
                          QUINE-3))))
           (QUINE-3 (COPY-TREE SOURCE)))
      (SETF (CAR (FIND-CAR :QUINE QUINE-3)) SOURCE)
      QUINE-3)))


;; -------------------------------------------------------------------
;; QUINE-1 and QUINE-2, since they're outputing a string of character,
;; must be used as follow to effectively loop the quine:

(read-from-string (with-output-to-string (*standard-output*) (quine-2)))

;; while the result of QUINE-2S and QUINE-3 can be evalued directly:

(eval (quine-3))


;; -------------------------------------------------------------------
;; LAMBDA QUINE:

((lambda (x) `(,x ',x)) '(lambda (x) `(,x ',x)))

;; cmucl: ((LAMBDA (X) `(,X ',X)) '(LAMBDA (X) `(,X ',X)))
;; clisp: ((LAMBDA (X) `(,X ',X)) '(LAMBDA (X) `(,X ',X)))
;; emacs: (#1=(lambda (x) (\` ((\, x) (quote (\, x))))) (quote #1#))
;; sbcl:  ((LAMBDA (X) (SB-IMPL::BACKQ-LIST X (SB-IMPL::BACKQ-LIST (QUOTE QUOTE) X))) (QUOTE (LAMBDA (X) (SB-IMPL::BACKQ-LIST X (SB-IMPL::BACKQ-LIST (QUOTE QUOTE) X)))))

;; 
;;;; quine.lisp                       -- 2004-03-14 00:46:53 -- pascal   ;;;;