q.scm

(define fixp? (lambda (f x) (equal? (f x) x)))
(define quine? (lambda (x) (fixp? eval x)))

(define apply1 (lambda (f) (lambda (x) (f x))))


(define fac*
  (lambda (f)
    (lambda (n)
      (if (< n 2)
	  1
	  (* n (f (- n 1)))))))

(define fac-apply-src
  '(lambda (f)
     (lambda (n)
       (if (< n 2)
	   1
	   (* n ((apply1 f) (- n 1)))))))

(define fac-eval-src
  '(lambda (s)
     (lambda (n)
       (if (< n 2)
	   1
	   (* n ((eval s) (- n 1)))))))


(define Y
  (lambda (f)
    ((lambda (g) (g g))
     (lambda (g)
       (f (lambda (x) ((g g) x)))))))

(define Q*
  (let ((t '(lambda (s t) `(,s (,t ',s ',t)))))
    (lambda (s) `(,s (,t ',s ',t)))))


(define Y0
  ((lambda (g) ((apply1 g) g))
   (lambda (g) (lambda (f) (f (lazy1 ((g g) f)))))))

(define Q0
  ((lambda  (t) ((eval t) t))
   '(lambda (t) (lambda (s) `(,s ((,t ',t) ',s))))))

(define Q
  (let ((y (quote
	    (lambda (x y)
	      (list x
		    (list y
			  (list (quote quote) x)
			  (list (quote quote) y)))))))
    (lambda (x)
      (list x
	    (list y
		  (list (quote quote) x)
		  (list (quote quote) y))))))

(define Q-src
  '(let ((y (quote
	     (lambda (x y)
	       (list x
		     (list y
			   (list (quote quote) x)
			   (list (quote quote) y)))))))
     (lambda (x)
       (list x
	     (list y
		   (list (quote quote) x)
		   (list (quote quote) y))))))


(define atom-count-src
  '(letrec
       ((f (lambda (x)
	     (cond
	      ((pair? x) (+ (f (car x)) (f (cdr x))))
	      ((null? x) 0)
	      (else 1))))) f))


(define inc-number-src
  '(let ((n 0))
     (letrec
	 ((f (lambda (x)
	       (cond
		((and (pair? x)
		      (eq? (car x) 'n)
		      (pair? (cdr x))
		      (number? (cadr x)))
		 `(n ,(mod (+ (cadr x) 1) 4)))
		((pair? x)
		 (cons (f (car x))
		       (f (cdr x))))
		(else x)))))
       f)))