Skip to content
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
Cannot retrieve contributors at this time
(ns church-factorial)
; def#
; ----
(defmacro def#
"A light wrapper around `def`, that keeps track of the
_source code_ for each definition
This let's us _unwrap_ all the definitions later : >"
[name v]
(def ~name ~v)
(alter-meta! (var ~name) assoc :source {:name '~name :v '~v})
(var ~name)))
; pair
; ----
(def# church-pair (fn [a b]
(fn [selector]
(selector a b))))
(def# take-first-arg (fn [a b] a))
(def# church-first (fn [pair]
(pair take-first-arg)))
(def# take-second-arg (fn [a b] b))
(def# church-second (fn [pair]
(pair take-second-arg)))
(def# ex-pair (church-pair 0 1))
(church-first ex-pair)
(church-second ex-pair))
; factorial-clj
; -------------
(defn factorial-clj [n]
(if (zero? n)
(* n (factorial-clj (dec n)))))
(comment (factorial-clj 5))
; church-numerals: 0-2
; ------------
(def# zero (fn [f v] v))
(def# one (fn [f v]
(f (zero f v))))
(def# two (fn [f v]
(f (one f v))))
; church-numeral->int
; ---------------
(defn church-numeral->int [church-numeral]
(church-numeral inc 0))
(map church-numeral->int [zero one two]))
; church-inc
; --------------
(def# church-inc
(fn [church-numeral]
(fn [f v]
(f (church-numeral f v)))))
(comment (church-numeral->int (church-inc (church-inc one))))
; int->church-numeral
; -----------------------------
(defn int->church-numeral [clojure-int]
(if (zero? clojure-int)
(church-inc (int->church-numeral (dec clojure-int)))))
(church-numeral->int (int->church-numeral 5)))
; shift-and-inc
; -------------
(def# shift-and-inc (fn [pair]
(church-second pair)
(church-inc (church-second pair)))))
(let [p (shift-and-inc (church-pair one two))]
(map church-numeral->int [(church-first p) (church-second p)])))
; church-dec
; -----------
(def# church-dec
(fn [church-numeral]
(church-numeral shift-and-inc
(church-pair zero zero)))))
(church-numeral->int (church-dec (int->church-numeral 10))))
; church-*
; --------------
(def# church-*
(fn [num-a num-b]
(fn [f v]
(num-a (partial num-b f) v))))
(church-* (int->church-numeral 5) (int->church-numeral 5))))
; church-booleans
; ---------------
(def# church-true (fn [when-true when-false]
(def# church-false (fn [when-true when-false]
; church-bool->bool
; -----------------------
(defn church-bool->bool [church-bool]
(church-bool true false))
(church-bool->bool church-true)
(church-bool->bool church-false))
; church-if
; ---------
(def# church-if (fn [church-bool when-true when-false]
(church-bool when-true when-false)))
(church-if church-true one two))
(church-if church-false one two)))
; church-zero?
; ------------
(def# church-zero?
(fn [church-numeral]
(church-numeral (fn [v] church-false) church-true)))
(church-bool->bool (church-zero? zero))
(church-bool->bool (church-zero? one)))
; factorial-v0
; ------------
(def# factorial-v0
(fn [church-numeral-n]
(church-zero? church-numeral-n)
(fn [] one)
(fn []
(factorial-v0 (church-dec church-numeral-n))))))))
(church-numeral->int (factorial-v0 (int->church-numeral 5))))
; y-combinator
; ------------
(def# make-recursable
(fn [injectable-f]
((fn [recursion-handler] (recursion-handler recursion-handler))
(fn [recursion-handler]
(injectable-f (fn [next-arg]
((recursion-handler recursion-handler) next-arg)))))))
; factorial-yc
; ------------
(def# injectable-factorial
(fn [factorial-cb]
(fn [church-numeral-n]
(church-zero? church-numeral-n)
(fn [] one)
(fn []
(factorial-cb (church-dec church-numeral-n)))))))))
(def# factorial-yc (make-recursable injectable-factorial))
(church-numeral->int (factorial-yc (int->church-numeral 5))))
; expand
; ------
(defn expand
"This takes a form like
(church-numeral->int (factorial-yc (int->church-numeral 5)))
And expands all the function definitions, to give
us the intuition for how our 'lambda calculus' way would look!"
(symbol? form)
(if-let [source (some-> (str *ns* "/" form)
(expand (:v source))
(seq? form)
(map expand form)
:else form))
(comment (expand '(factorial-yc (church-inc (church-inc (church-inc two))))))