gistfile1.clj

(ns fn-pre-post
  (:refer-clojure :exclude (defn fn defn-)))

(clojure.core/defn- insert-arg
  "Insert arg in the second position of the form cond."
  [arg cond]
  (cons (first cond) (cons arg (rest cond))))

(clojure.core/defn- parse-params
  "Parse a parameter vector, possibly containing nested vectors for
   destructuring, and return the extracted precondition map plus the
   parameter vector without the preconditions."
  [conds params]
  (loop [conds              conds
	 [f & r :as params] params
	 out                []]
    (cond (list? f)   (let [cs (take-while list? params)
			    [s & r]  (drop (count cs) params)]
			(when-not (symbol? s)
			  (throw (Exception. "precondition without symbol")))
			(recur (assoc conds :pre
				      (apply conj (get conds :pre '[])
					     (map (partial insert-arg s) cs)))
			       r
			       (conj out s)))
	  (symbol? f) (recur conds r (conj out f))
	  (vector? f) (let [[c o] (parse-params conds f)]
			(recur c r (conj out o)))
	  :else       [conds out])))

(clojure.core/defn- add-conditions
  "Extract preconditions from the parameter vector params, combine them with
   pre- and postconditions in the map conds, and insert them before body,
   checking for an already present condition map, in which case the
   conditions are combined."
  [conds [params & body]]
  (let [has-conds?     (and (map? (first body)) (rest body))
	conds          (if has-conds?
			 (merge-with (comp vec concat) conds (first body))
			 conds)
	body           (if has-conds? (rest body) body)
	[conds params] (parse-params conds params)]
    (if conds
      (cons params (cons conds body))
      (cons params body))))

(defmacro defn
  "Like clojure.core/defn, but allow the specifiction of pre- and post-
   conditions just before the function name and parameters."
  [& args]
  (let [post     (vec (map (partial insert-arg '%)
			   (take-while list? args)))
	args     (drop (count post) args)
	[name & args]  args
	doc      (when (string? (first args)) (first args))
	args     (if doc (rest args) args)
	attr-map (when (map? (first args)) (first args))
	args     (if attr-map (rest args) args)
	bodies   (if (list? (first args)) args (list args))
	bodies   (map (partial add-conditions {:post post}) bodies)]
    `(clojure.core/defn ~name
       ~@(when doc (list doc))
       ~@(when attr-map (list attr-map))
       ~@bodies)))

(defmacro defn-
  "same as defn, yielding non-public def"
  [name & decls]
    (list* `defn (with-meta name (assoc (meta name) :private true)) decls))

(clojure.core/defn- cond?
  "return true if form is a pre- or post-condition"
  [form]
  (and (list? form)
       (not (vector? (first form)))))

(defmacro fn
  "Like clojure.core/fn, but allow the specifiction of pre- and post-
   conditions just before the function bodies and parameters."
  [& args]
  (let [post     (vec (map (partial insert-arg '%)
			   (take-while cond? args)))
	args     (drop (count post) args)
	name     (when (symbol? (first args)) (first args))
	args     (if name (rest args) args)
	bodies   (if (list? (first args)) args (list args))
	bodies   (map (partial add-conditions {:post post}) bodies)]
    `(clojure.core/fn ~@(when name (list name))
       ~@bodies)))


; Usage examples
(comment

(defn (pos?) (integer?) foo
  "A stupid function"
  [(pos?) x (> 42) y]
  (+ x y))

(fn (> 0) (< 3) [(number?) (pos?) x] (dec x))

)