《计算的本质》第 6 章使用 clojure 基于 lambda 演算实现 FizzBuzz 程序。

fizz_buzz.clj

(ns fizz-buzz
  "《计算的本质》第 6 章使用 clojure 基于 lambda 演算实现 FizzBuzz 程序。")

(def zero (fn [p] (fn [x] x)))
(def one (fn [p] (fn [x] (p x))))
(def two (fn [p] (fn [x] (p (p x)))))
(def three (fn [p] (fn [x] (p (p (p x))))))
(def four (fn [p] (fn [x] (p (p (p (p x)))))))
(def five (fn [p] (fn [x] (p (p (p (p (p x))))))))

(defmacro define-number [name n]
  (let [body (reduce (fn [ret _] (list 'p ret)) 'x (range 0 n))]
    `(def ~name
       (fn [~'p]
         (fn [~'x]
           ~body)))))

(define-number fifteen 15)
(define-number hundred 100)


(defn to-integer [p]
  ((p (fn [n]
        (+ n 1)))
   0))

(def TRUE (fn [x] (fn [y] x)))
(def FALSE (fn [x] (fn [y] y)))

(defn IF [p]
  p)

(defn to-boolean [p]
  (((IF p)
    true)
   false))

(defn ZERO? [p]
  ((p (fn [x] FALSE))
   TRUE))

(defn pair [x]
  (fn [y]
    (fn [f]
      ((f x) y))))

(defn left [p]
  (p
   (fn [x]
     (fn [y]
       x))))


(defn right [p]
  (p
   (fn [x]
     (fn [y]
       y))))

(defn increment [n]
  (fn [p]
    (fn [x]
      (p ((n p) x)))))


(defn- slide [p]
  ((pair (right p))
   (increment (right p))))

(defn decrement [n]
  (left
   ((n slide)
    ((pair zero)
     zero))))


(defn add [m]
  (fn [n]
    ((n increment)
     m)))

(defn sub [m]
  (fn [n]
    ((n decrement)
     m)))

(defn multiply [m]
  (fn [n]
    ((n (add m))
     zero)))

(defn power [m]
  (fn [n]
    ((n (multiply m))
     one)))


(defn LESS-OR-EQ? [m]
  (fn [n]
    (ZERO?
     ((sub m) n))))

(defn MOD1
  "函数体里用到了 MOD，理论上 MOD 其实还没有定义。"
  [m]
  (fn [n]
    (((IF ((LESS-OR-EQ? n) m))
      (fn [x] (((MOD1 ((sub m) n)) n) x)))
     m)))

(defn Y [f]
  ((fn [x]
     (f
      (x x)))
   (fn [x]
     (f
      (x x)))))

(defn Z [f]
  ((fn [x]
     (f
      (fn [y]
        ((x x) y))))
   (fn [x]
     (f
      (fn [y]
        ((x x) y))))))

(def MOD
  "用 Z 组合子重新定义 MOD"
  (Z
   (fn [f]
     (fn [m]
       (fn [n]
         (((IF ((LESS-OR-EQ? n) m))
           (fn [x] (((f ((sub m) n)) n) x)))
          m))))))

(def EMPTY ((pair TRUE) TRUE))

(def EMPTY? left)

(defn unshift [l]
  (fn [x]
    ((pair FALSE)
     ((pair x)
      l))))

(defn FIRST [l]
  (left
   (right l)))

(defn REST [l]
  (right
   (right l)))

(def my-list
  ((unshift
    ((unshift
      ((unshift EMPTY)
       THREE))
     TWO))
   ONE))

(defn to-arr [l]
  (loop [a []
         l l]
    (if (to-boolean (EMPTY? l))
      a
      (recur
       (conj a (FIRST l))
       (REST l)))))

(def RANGE
  (Z
   (fn [f]
     (fn [m]
       (fn [n]
         (((IF ((LESS-OR-EQ? m) n))
           (fn [x]
             (((unshift ((f (increment m)) n))
               m) x)))
          EMPTY))))))

(def fold
  (Z
   (fn [f]
     (fn [l]
       (fn [x]
         (fn [g]
           (((IF (EMPTY? l))
             x)
            (fn [y]
              (((g
                 (((f (REST l)) x) g))
                (FIRST l))
               y)))))))))

(defn MAP
  [k]
  (fn [f]
    (((fold k) EMPTY)
     (fn [l]
       (fn [x]
         ((unshift l)
          (f x)))))))

(comment
  (let [my-range ((RANGE one) hundred)]
    (println (to-integer (((fold my-range) zero) add)))
    (println (to-arr ((MAP my-range) to-integer)))))


(def ten ((multiply two) five))

(def B ten)
(def F (increment B))
(def I (increment F))
(def U (increment I))
(def ZED (increment U))

(def FIZZ
  ((unshift
    ((unshift
      ((unshift ((unshift EMPTY) ZED))
       ZED))
     I))
   F))

(def BUZZ
  ((unshift
    ((unshift
      ((unshift ((unshift EMPTY) ZED))
       ZED))
     U))
   B))

(def FIZZBUZZ
  ((unshift
    ((unshift
      ((unshift ((unshift BUZZ) ZED))
       ZED))
     I))
   F))

(defn to-char [c]
  (get
   (vec "0123456789BFiuz")
   (to-integer c)))

(defn to-string [s]
  (clojure.string/join
   (map to-char (to-arr s))))

(comment
  (println (to-string FIZZBUZZ)))

(def div
  (Z
   (fn [f]
     (fn [m]
       (fn [n]
         (((IF ((LESS-OR-EQ? n) m))
           (fn [x]
             ((increment
               ((f ((sub m) n)) n))
              x)))
          zero))))))

(defn push [l]
  (fn [x]
    (((fold l)
      ((unshift EMPTY) x))
     unshift)))

(def to-digits
  (Z
   (fn [f]
     (fn [n]
       ((push
         (((IF ((LESS-OR-EQ? n) (decrement ten)))
           EMPTY)
          (fn [x]
            ((f ((div n) ten)) x))))
        ((MOD n) ten))))))


(comment
  (let [s ((MAP
            ((RANGE one) hundred))
           (fn [n]
             (((IF (ZERO? ((MOD n) fifteen)))
               FIZZBUZZ)
              (((IF (ZERO? ((MOD n) three)))
                FIZZ)
               (((IF (ZERO? ((MOD n) five)))
                 BUZZ)
                (to-digits n))))))]
    (map to-string
         (to-arr s))))