#lang racket
(require "LC.rkt" redex)

(define-term tt (λ (x) (λ (y) x)))
(define-term ff (λ (x) (λ (y) y)))
(define-term if (λ (b) (λ (thn) (λ (els) ((b thn) els)))))

(define-term not (λ (b) (((if b) ff) tt)))
#;
(begin
  (test-judgment-holds (->>n (not tt) (λ (X) (λ (Y) Y))))
  (test-judgment-holds (->>n (not ff) (λ (X) (λ (Y) X)))))

(define-term and (λ (b1) (λ (b2) (((if b1) b2) ff))))
#;
(begin
  (test-judgment-holds (->>n ((and tt) tt) (λ (X) (λ (Y) X))))
  (test-judgment-holds (->>n ((and tt) ff) (λ (X) (λ (Y) Y))))
  (test-judgment-holds (->>n ((and ff) tt) (λ (X) (λ (Y) Y))))
  (test-judgment-holds (->>n ((and ff) ff) (λ (X) (λ (Y) Y)))))

(define-term or (λ (b1) (λ (b2) (((if b1) tt) b2))))
#;
(begin
  (test-judgment-holds (->>n ((or tt) tt) (λ (X) (λ (Y) X))))
  (test-judgment-holds (->>n ((or tt) ff) (λ (X) (λ (Y) X))))
  (test-judgment-holds (->>n ((or ff) tt) (λ (X) (λ (Y) X))))
  (test-judgment-holds (->>n ((or ff) ff) (λ (X) (λ (Y) Y)))))

(define-term kons
  (λ (hd) (λ (tl) (λ (f) ((f hd) tl)))))
(define-term kar
  (λ (pr) (pr (λ (hd) (λ (tl) hd)))))
(define-term kdr
  (λ (pr) (pr (λ (hd) (λ (tl) tl)))))

#;
(test-judgment-holds (->>n (kar ((kons x) y)) x))
#;
(test-judgment-holds (->>n (kdr ((kons x) y)) y))

(define-term zero
  (λ (f) (λ (x) x)))

(define-term one
  (λ (f) (λ (x) (f x))))

(define-term two
  (λ (f) (λ (x) (f (f x)))))

(define-term three
  (λ (f) (λ (x) (f (f (f x))))))

(define-term four
  (λ (f) (λ (x) (f (f (f (f x)))))))

(define-term five
  (λ (f) (λ (x) (f (f (f (f (f x))))))))

(define-term six
  (λ (f) (λ (x) (f (f (f (f (f (f x)))))))))

(define-term plus
  (λ (n)
    (λ (m)
      (λ (f)
        (λ (x)
          ((m f)
           ((n f)
            x)))))))

#;
(test-judgment-holds (->>n ((((plus two) one) s) z)
                           (s (s (s z)))))
#;
(test-judgment-holds (->>n ((((plus two) three) s) z)
                           (s (s (s (s (s z)))))))

(define-term times
  (λ (n)
    (λ (m)
      (λ (f)
        (λ (x)
          ((m (n f)) x))))))

#;
(test-judgment-holds (->>n ((((times two) one) s) z)
                           (s (s z))))
#;
(test-judgment-holds (->>n ((((times two) three) s) z)
                           (s (s (s (s (s (s z))))))))

#;
;; this one is too hard to find normal forms for poor redex.
(define-term sub1
  (λ (n)
    (kdr
     ((n (λ (pr) ((kons ((plus one) (kar pr))) (kar pr))))
      ((kons zero) zero)))))

;; but we can do the same thing in racket:

(let ([kons (λ (x) (λ (y) (cons x y)))]
      [kar car]
      [kdr cdr]
      [zero (λ (f) (λ (x) x))]
      [one (λ (f) (λ (x) (f x)))]
      [plus (λ (n)
              (λ (m)
                (λ (f)
                  (λ (x)
                    ((m f)
                     ((n f)
                      x))))))])
  (define sub1
    (λ (n)
      (kdr
       ((n (λ (pr) ((kons ((plus one) (kar pr))) (kar pr))))
        ((kons zero) zero)))))
  (((sub1 (λ (f) (λ (x) (f (f (f (f (f x)))))))) add1) 0))


(test-results)