encoding.scm

;; booleans and pairs
(define ltrue `(lambda (x) (lambda (y) x)))
(define lfalse `(lambda (x) (lambda (y) y)))
(define lpair `(lambda (x) (lambda (y) (lambda (p) ((p x) y)))))
(define lcar `(lambda (p) (p ,ltrue)))
(define lcdr `(lambda (p) (p ,lfalse)))

;; numbers and operations
(define decode-number (lambda (n) ((n add1) 0)))
(define lzero `(lambda (f) (lambda (x) x)))
(define lone `(lambda (f) (lambda (x) (f x))))
(define ltwo `(lambda (f) (lambda (x) (f (f x)))))
(define lthree `(lambda (f) (lambda (x) (f (f (f x))))))
(define lfour `(lambda (f) (lambda (x) (f (f (f (f x)))))))
(define lfive `(lambda (f) (lambda (x) (f (f (f (f (f x))))))))
(define l6 `(lambda (f) (lambda (x) (f (f (f (f (f (f x)))))))))
(define l7 `(lambda (f) (lambda (x) (f (f (f (f (f (f (f x))))))))))

(define lzero? `(lambda (n) ((n (lambda (x) ,lfalse)) ,ltrue)))
(define lsucc `(lambda (n) (lambda (f) (lambda (x) (f ((n f) x))))))

; Daniel Smith's pred
(define lpred
  '(lambda (n)
     (lambda (w)
       (lambda (z)
         (((n (lambda (l) (lambda (h) (h (l w))))) (lambda (d) z))
          (lambda (x) x))))))

(define lpred `(lambda (n)
                 (,lcar ((n (lambda (p) 
                              ((,lpair (,lcdr p)) (,lsucc (,lcdr p)))))
                         ((,lpair ,lzero) ,lzero)))))

(define lplus `(lambda (m) (lambda (n) (lambda (f) (lambda (x) ((m f) ((n f) x)))))))
(define lsub `(lambda (m) (lambda (n) ((n ,lpred) m))))
(define ltimes `(lambda (m) (lambda (n) (lambda (f) (lambda (x) ((m (n f)) x))))))
(define lpow `(lambda (m) (lambda (n) (lambda (f) (lambda (x) (((m n) f) x))))))

;; call-by-value Y combinator
(define Y
  `(lambda (f)
     ((lambda (u) (u u))
      (lambda (x) (f (lambda (t) ((x x) t)))))))

;; version 1 (using poorman's Y)
(define !-half
  `(lambda (!)
     (lambda (n)
       ((((,lzero? n)
          (lambda (t) ,lone))
         (lambda (t) ((,ltimes n) ((! !) (,lpred n)))))
        (lambda (v) v)))))

(define ! `(,!-half ,!-half))
(define !-5 `(,! ,lfive))


;; version 2 (using CBV Y)
(define !-gen
  `(lambda (!)
     (lambda (n)
       ((((,lzero? n)
          (lambda (t) ,lone))
         (lambda (t) ((,ltimes n) (! (,lpred n)))))
        (lambda (v) v)))))

(define ! `(,Y ,!-gen))

;; version 3 (CBN)
;; call-by-name Y
(define Y-n
  `(lambda (f)
     ((lambda (x) (f (x x)))
      (lambda (x) (f (x x))))))

(define !-gen-n
  `(lambda (!)
     (lambda (n)
       (((,lzero? n) ,lone) ((,ltimes n) (! (,lpred n)))))))

(define !-n `(,Y-n ,!-gen-n))


;; example use:
;; (decode-number (eval `(,! ,lfive)))