Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defn tramp-fn [f]
- (if (fn? f)
- (fn [& args] #(apply f args))
- f))
- (defn tramp-fn2 [f]
- (if (fn? f) (partial trampoline f) f))
- (defmacro letrec [bindings & body]
- (let [bcnt (quot (count bindings) 2)
- arrs (gensym "bindings_array")
- arrv `(make-array Object ~bcnt)
- bprs (partition 2 bindings)
- bssl (map first bprs)
- bsss (set bssl)
- bexs (map second bprs)
- arrm (zipmap bssl (range bcnt))
- btes (map #(prewalk (fn [f]
- (if (bsss f)
- `(tramp-fn (aget ~arrs ~(arrm f)))
- f))
- %)
- bexs)]
- `(let [~arrs ~arrv]
- ~@(map (fn [s e]
- `(aset ~arrs ~(arrm s) ~e))
- bssl
- btes)
- (let [~@(mapcat (fn [s]
- [s `(tramp-fn2 (aget ~arrs ~(arrm s)))])
- bssl)]
- ~@body))))
Add Comment
Please, Sign In to add comment