lambda recursion

rec.clj

(ns xp.rec)

(do :chapter1

    ;; clojure
    (defn f [x]
      (if (zero? x) x (f (dec x))))

    ;; without recursion
    (def f1
      (let [f (fn [self x]
                (if (zero? x) x (self self (dec x))))]
        (fn [x] (f f x))))

    ;; without let
    (def f2
      ((fn [f] (fn [x] (f f x)))
       (fn [self x] (if (zero? x) x (self self (dec x))))))

    (assert (= 0 (f 10) (f1 10) (f2 10)))

    ;; lets write a macro that do this transformation for us

    (defn process-rec-calls [x name]
      (if (seq? x)
        (if (= name (first x))
          (list* name name (process-rec-calls (next x) name))
          (map #(process-rec-calls % name) x))
        x))

    (defmacro rfn [name argv & body]
      `((fn [f#] (fn ~argv (f# f# ~@argv)))
        (fn [~name ~@argv] ~@(process-rec-calls body name))))

    ((rfn f [x]
          (if (zero? x) x (f (dec x))))
     10)

    ;; how about mutually recursive lambdas ?

    ;; clojure
    (letfn [(even? [x] (if (zero? x) true (odd? (dec x))))
            (odd? [x] (if (zero? x) false (even? (dec x))))]
      (and (odd? 11) (even? 42)))

    ;; with simple let, without recursion
    (let [f (fn [even? odd? x] (if (zero? x) true (odd? odd? even? (dec x))))
          g (fn [odd? even? x] (if (zero? x) false (even? even? odd? (dec x))))
          even? (fn [x] (f f g x))
          odd? (fn [x] (g g f x))]
      (and (odd? 11) (even? 42)))

    ;; lets write a macro that do this transformation for us

    (defn process-mutually-rec-calls [x names]
      (if (seq? x)
        (if (contains? (set names) (first x))
          (-> (cons (first x) names)
              (concat (process-mutually-rec-calls (next x) names)))
          (map #(process-mutually-rec-calls % names) x))
        x))

    (defmacro letfns
      [fns & body]
      (let [
            names (mapv first fns)
            syms (mapv gensym names)
            name->sym (zipmap names syms)

            name->argv
            (reduce (fn [ret [name argv]] (assoc ret name argv))
                    {} fns)

            name->recursive-form
            (reduce (fn [ret [name argv & body]]
                      (assoc ret name
                                 `(fn ~(vec (concat names argv))
                                    ~@(process-mutually-rec-calls body names))))
                    {} fns)

            recursive-bindings
            (mapcat (fn [[n form]] [(name->sym n) form])
                    name->recursive-form)

            fn-bindings
            (mapcat (fn [n]
                      [n `((fn ~names
                             (fn ~(name->argv n)
                               ~@(drop 2 (name->recursive-form n))))
                           ~@syms)])
                    names)]

        `(let ~(vec (concat recursive-bindings fn-bindings))
           ~@body)))

    (letfns [(even? [x] (if (zero? x) true (odd? (dec x))))
             (odd? [x] (if (zero? x) false (even? (dec x))))]
            (and (odd? 11) (even? 42)))

    ;; but wait how about stack overflows ?

    '((rfn f [x]
           (if (zero? x) x (f (dec x))))
      10000)

    ;; by the way this will too !

    '(letfn [(even? [x] (if (zero? x) true (odd? (dec x))))
             (odd? [x] (if (zero? x) false (even? (dec x))))]
       (even? 10000))
    
    ;; TO BE CONTINUED ...
    )

(do :chapter2

    ;; so we will use some kind of trampoline technique to deal with this

    (defrecord Lazy [thunk])

    (defmacro lazy [expr]
      `(->Lazy (fn [] ~expr)))

    (defn realize [x]
      (if (instance? Lazy x)
        (recur ((:thunk x)))
        x))

    (defn process-rec-calls2 [x name]
      (if (seq? x)
        (if (= name (first x))
          (list `lazy (list* name name (process-rec-calls2 (next x) name)))
          (map #(process-rec-calls2 % name) x))
        x))

    (defmacro rfn2 [name argv & body]
      `((fn [f#] (fn ~argv (realize (f# f# ~@argv))))
        (fn [~name ~@argv] ~@(process-rec-calls2 body name))))

    ;; it seems to work !

    ((rfn2 f [x]
           (if (zero? x) x (f (dec x))))
     10000)

    ;; now lets apply the same modification on our letfns macro

    (defn process-mutually-rec-calls2 [x names]
      (if (seq? x)
        (if (contains? (set names) (first x))
          (list `lazy
                (-> (cons (first x) names)
                    (concat (process-mutually-rec-calls2 (next x) names))))
          (map #(process-mutually-rec-calls2 % names) x))
        x))

    (defmacro letfns2
      [fns & body]
      (let [
            names (mapv first fns)
            syms (mapv gensym names)
            name->sym (zipmap names syms)

            name->argv
            (reduce (fn [ret [name argv]] (assoc ret name argv))
                    {} fns)

            name->recursive-form
            (reduce (fn [ret [name argv & body]]
                      (assoc ret name
                                 `(fn ~(vec (concat names argv))
                                    ~@(process-mutually-rec-calls2 body names))))
                    {} fns)

            recursive-bindings
            (mapcat (fn [[n form]] [(name->sym n) form])
                    name->recursive-form)

            fn-bindings
            (mapcat (fn [n]
                      [n `((fn ~names
                             (fn ~(name->argv n)
                               (realize ~@(drop 2 (name->recursive-form n)))))
                           ~@syms)])
                    names)]

        `(let ~(vec (concat recursive-bindings fn-bindings))
           ~@body)))

    ;; and its ok too !

    (letfns2 [(even? [x] (if (zero? x) true (odd? (dec x))))
              (odd? [x] (if (zero? x) false (even? (dec x))))]
             (even? 10000)))