quines!

quine.el

;; Quines evaluating to themselves
;; subjects to study
(let ((let '`(let ((let ',let)) ,let))) `(let ((let ',let)) ,let))
((lambda (lambda) `(,lambda ',lambda)) '(lambda (lambda) `(,lambda ',lambda)))
(let ((let (lambda (lambda) `(let ((let ,lambda)) (funcall let ',lambda))))) (funcall let '(lambda (lambda) `(let ((let ,lambda)) (funcall let ',lambda)))))

;; quines written in a more human-readable way
(let ((x '`(let ((x ',x)) ,x))) `(let ((x ',x)) ,x))     ;; (1)
((lambda (y) `(,y ',y)) '(lambda (y) `(,y ',y)))         ;; (2)
(let ((f (lambda (x) `(let ((f ,x)) (funcall f ',x)))))  ;; (3)
  (funcall f '(lambda (x) `(let ((f ,x)) (funcall f ',x)))))

;; preliminary observation of their structure yields these generalizations
(defun omega (n)
  (cl-labels ((fs (n)
                (cond ((zerop n) (cadr '`(funcall ,x ',x)))
                      (t `(funcall ,(fs (1- n)) ,(cons (car ''x) (cdr '`,x))))))
              (ls (n form)
                (cond ((zerop n) (cons (car ``x) (list form)))
                      (t `(lambda (x) ,(ls (1- n) form))))))
    (eval `(,(ls 1 (fs n)) ',(ls (1+ n) (fs n))))))
(omega 0)
(funcall (lambda (x) `(funcall ,x ',x)) '(lambda (x) `(funcall ,x ',x)))

(omega 2)
(funcall (funcall (funcall (lambda (x) (lambda (x) (lambda (x) `(funcall (funcall (funcall ,x ',x) ',x) ',x)))) '(lambda (x) (lambda (x) (lambda (x) `(funcall (funcall (funcall ,x ',x) ',x) ',x))))) '(lambda (x) (lambda (x) (lambda (x) `(funcall (funcall (funcall ,x ',x) ',x) ',x))))) '(lambda (x) (lambda (x) (lambda (x) `(funcall (funcall (funcall ,x ',x) ',x) ',x)))))

;; let (substitution) is quite the equivalent of beta reduction, so it's also possible
(defun letgen (n)
  (cl-labels ((fs (n)
                (cond ((zerop n) (cadr '`(let ((let ',let)) ,let)))
                      (t `(let ((let ',(cadr '`,let))) ,(fs (1- n))))))
              (ls (n form)
                (cond ((zerop n) (cons (car ``x) (list form)))
                      (t `(lambda (let) ,(ls (1- n) form))))))
    (eval `(,(ls 1 (fs n)) ',(ls 0 (fs n))))))
(letgen 0)
(let ((let '`(let ((let ',let)) ,let))) `(let ((let ',let)) ,let))

(letgen 2)
(let ((let '`(let ((let ',let)) (let ((let ',let)) (let ((let ',let)) ,let))))) (let ((let '`(let ((let ',let)) (let ((let ',let)) (let ((let ',let)) ,let))))) (let ((let '`(let ((let ',let)) (let ((let ',let)) (let ((let ',let)) ,let))))) `(let ((let ',let)) (let ((let ',let)) (let ((let ',let)) ,let))))))

;; looking at these self-similar, fractal like structures, maybe we're just dealing with a Y combinator somewhere!

;; turns out, all are abstracted away by writing some Y combinators
(defun Y (f) (eval `(let ((x ',f)) ,f)))
(defun Y (f) (cl-subst-if f (lambda (x) (and (consp x) (eq '\, (car x)))) (cadr f)))
(Y '`(let ((x ',x)) ,x)) ;; =>
(let ((x '`(let ((x ',x)) ,x))) `(let ((x ',x)) ,x))  ;; (1)

(defun Y2 (f l)
  (let ((x (eval `(let ((x ',f)) ,l))))
    (eval f)))
(defun Y2 (f l)
  (let ((commap (lambda (x) (and (consp x) (eq '\, (car x))))))
    (cl-subst-if (cl-subst-if f commap (cadr l)) commap (cadr f))))

(Y2 '`(funcall (funcall ,x ',x) ',x)
    '`(lambda (x) (lambda (x) ,x)))

(Y2 '`(let ((x ,x)) (funcall x ',x))
    '`(lambda (x) ,x)) ;; => (3)
(let ((x (lambda (x) `(let ((x ,x)) (funcall x ',x))))) (funcall x '(lambda (x) `(let ((x ,x)) (funcall x ',x)))))

quine.lisp

(defun Y (f) (cadr (subst-if f 'sb-int:comma-p f)))
(Y '`(let ((let ',let)) (let ((let ',let)) ,let)))

(defun Y2 (f l) (cadr (subst-if (cadr (subst-if f 'sb-int:comma-p l)) 'sb-int:comma-p f)))
(Y2 '`(funcall (funcall ,x ',x) ',x)
    '`(lambda (x) (lambda (x) ,x)))

(Y2 '`(let ((x ,x)) (funcall x ',x))
    '`(lambda (x) ,x))