Binary trees as their own folds in untyped lambda calculus (by way of Scheme)

tree.rkt

#lang scheme

(define I (lambda (x) x))
(define K (lambda (x) (lambda (y) x)))
(define bool-true K)
(define bool-false (K I))
(define bool-to-native (lambda (b) ((b #t) #f)))
(define maybe-nothing K)
(define maybe-just (lambda (x) (lambda (c) (lambda (f) (f x)))))
(define maybe-to-value-with-default (lambda (def) (lambda (m) ((m def) I))))
(define just-to-value (maybe-to-value-with-default #f))
(define triple-cons (lambda (x) (lambda (y) (lambda (z) (lambda (f) (((f x) y) z))))))
(define triple-1st (lambda (x) (lambda (y) (lambda (z) x))))
(define triple-2nd (lambda (x) (lambda (y) (lambda (z) y))))
(define triple-3rd (lambda (x) (lambda (y) (lambda (z) z))))
(define bt-leaf K)
(define bt-node (lambda (l) (lambda (v) (lambda (r)
                                          (lambda (c) (lambda (f)
                                                        (((f ((l c) f)) v) ((r c) f))))))))
(define bt-to-triple (lambda (t)
                       ((t maybe-nothing)
                        (lambda (l) (lambda (v) (lambda (r)
                                                  (maybe-just (((triple-cons ((l bt-leaf) (lambda (t) (t bt-node))))
                                                                v)
                                                               ((r bt-leaf) (lambda (t) (t bt-node)))))))))))
(define bt-maybe-value (lambda (mt) ((mt maybe-nothing) (lambda (t) (((bt-to-triple t) maybe-nothing) (lambda (t) (maybe-just (t triple-2nd))))))))
(define bt-maybe-left (lambda (mt) ((mt maybe-nothing) (lambda (t) (((bt-to-triple t) maybe-nothing) (lambda (t) (maybe-just (t triple-1st))))))))
(define bt-maybe-right (lambda (mt) ((mt maybe-nothing) (lambda (t) (((bt-to-triple t) maybe-nothing) (lambda (t) (maybe-just (t triple-3rd))))))))
(define bt-leaf? (lambda (t) ((t bool-true) (lambda (l) (lambda (v) (lambda (r) bool-false))))))
(define bt-sum (lambda (t) ((t 0) (lambda (l) (lambda (v) (lambda (r) (+ l v r)))))))
(define bt-height (lambda (t) ((t 0) (lambda (l) (lambda (v) (lambda (r) (+ 1 (max l r))))))))

;;
(define tree (((bt-node (((bt-node bt-leaf) 2) (((bt-node bt-leaf) 4) bt-leaf))) 1) (((bt-node bt-leaf) 3) bt-leaf)))

;;
(bt-sum tree)
(bt-height tree)
(just-to-value (bt-maybe-value (maybe-just tree)))
(just-to-value (bt-maybe-value (bt-maybe-left (maybe-just tree))))
(just-to-value (bt-maybe-value (bt-maybe-right (bt-maybe-left (maybe-just tree)))))
(just-to-value (bt-maybe-value (bt-maybe-right (maybe-just tree))))
(bool-to-native (bt-leaf? tree))
(bool-to-native (bt-leaf? (just-to-value (bt-maybe-left (maybe-just tree)))))
(bool-to-native (bt-leaf? (just-to-value (bt-maybe-left (bt-maybe-left (maybe-just tree))))))
(bool-to-native (bt-leaf? (just-to-value (bt-maybe-right (bt-maybe-left (maybe-just tree))))))