-
-
Save himerzi/eac808efd50bc74f1574 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns prndoc.core | |
(require | |
[clojure.core.strint :refer [<<]] | |
[clojure.core.match :refer [match]])) | |
(defn has-splat? [arglist] | |
((complement nil?) (first (last (split-with #(not= % '&) arglist))))) | |
(defn parse-arg-pattern | |
"Argument pattern [num-args has-splat?]. Pattern of [func & body] is [1 true]." | |
[arglist] | |
(if | |
(has-splat? arglist) [(- (count arglist) 2) true] [(count arglist) false] | |
) | |
) | |
(defn match-arglist | |
"Find the matching arglist." | |
[arglists args] | |
(first (filter #(or (= (parse-arg-pattern args) (parse-arg-pattern %)) | |
(and (= (last (parse-arg-pattern %)) true) (> (first (parse-arg-pattern args)) (first (parse-arg-pattern %))))) arglists)))) | |
(defn arg-bindings | |
"Return bindings of form [n 4 members []]" | |
[arglists args] | |
(let [arglist (match-arglist arglists args) | |
[num-args splat?] (parse-arg-pattern arglist) | |
split-args (split-at num-args args)] | |
(if splat? (vec (interleave (filter #(not= '& %) arglist) (conj (vec (first split-args)) (vec (last split-args))))) | |
(vec (interleave arglist args))) | |
)) | |
(defn docprint-decorator | |
"Print a function's docstring at runtime, with interpolated values of args." | |
[m# f] | |
(fn [& args] | |
(do | |
(eval `(let ~(arg-bindings (:arglists m#) args) (prn (<< ~(:doc m#))))) | |
(apply f args)))) | |
(defmacro docprint! | |
"Apply docprint decorator to function. Do not apply more than once." | |
[sym] | |
`(let [m# (meta (var ~sym))] | |
(when (not= true (:docprint m#)) | |
(def ~sym ((partial docprint-decorator m#) ~sym)) | |
(reset-meta! (var ~sym) (assoc m# :docprint true))) | |
(var ~sym))) | |
; toy functions | |
(defn elect-n | |
"Electing ~{n} members to a group" | |
([n] (elect-n n [])) | |
([n members] members) | |
([n members & options] members) | |
) | |
(defn accept-many-args | |
"This function was called with ~(count more) additional arguments, ~(+ 2 (count more)) in total." | |
[n1 n2 & more]) | |
(defn add-two | |
"Adding ~{a} to ~{b}." | |
[a b] | |
(+ a b)) | |
(docprint! accept-many-args) | |
(docprint! elect-n) | |
(docprint! add-two) | |
(do | |
(accept-many-args 1 2 3 4 5 6 7 8 9 10) | |
(elect-n 5 []) | |
(add-two 1 2)) | |
;has-splat? | |
(= false (has-splat? '[n members])) | |
(= true (has-splat? '[func & body])) | |
;match-arglist | |
(= '[n] (match-arglist '([n] [n members] [n members & options]) '(4))) | |
(= '[n members] (match-arglist '([n] [n members] [n members & options]) '(4 []))) | |
(= '[n members & options] (match-arglist '([n] [n members] [n members & options]) '(4 [] "fred"))) | |
;parse-arg-pattern | |
(= [1 true] (parse-arg-pattern '[func & body])) | |
(= [2 false] (parse-arg-pattern '[n members])) | |
;arg-bindings | |
(= '[n 4] (arg-bindings '([n] [n members] [n members & options]) '(4))) | |
(= '[n 4 members []] (arg-bindings '([n] [n members] [n members & options]) '(4 []))) | |
(= '[n 4 members [] options (1 2)] (arg-bindings '([n] [n members] [n members & options]) '(4 [] 1 2))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment