Moving over contract building functions and utils.

clojure · May 7, 2012 · eec81d8 · eec81d8
1 parent fde7014
commit eec81d8
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 25 deletions.
diff --git a/src/main/clojure/clojure/core/contracts/impl/transformers.clj b/src/main/clojure/clojure/core/contracts/impl/transformers.clj
@@ -0,0 +1,39 @@
+(ns clojure.core.contracts.impl.transformers
+  (:require [clojure.core.unify :as unify]
+            [clojure.core.contracts.impl.utils :as utils]))
+
+
+(defn build-condition-body
+  [p body prefix-msg]
+  (unify/subst
+   {'?P      p
+    '?PREFIX prefix-msg
+    '?BODY   body}
+
+   '(try
+      ((fn [] {?P ?PRE}
+         ?BODY))
+      (catch AssertionError ae
+        (throw (AssertionError. (str ?PREFIX ?MSG \newline (.getMessage ae))))))))
+
+
+(defn- build-pre-post-map
+  "(build-pre-post-map '[(odd? n) (pos? n) => (int? %)])
+   ;=> {:pre [...] :post [...]}
+  "
+  [cnstr]
+  (if (vector? cnstr)
+    (let [[L M R] (partition-by #{'=>} cnstr)]
+      {:pre  (vec (when (not= L '(=>)) L))
+       :post (vec (if (= L '(=>)) M R))})
+    cnstr))
+
+
+(defn- tag-hocs
+  [cnstr]
+  (map (fn [form]
+         (if (and (seq? form) (= '_ (first form)))
+           (list 'fn? (second form))
+           form))
+       cnstr))
+
diff --git a/src/main/clojure/clojure/core/contracts/impl/utils.clj b/src/main/clojure/clojure/core/contracts/impl/utils.clj
@@ -1,34 +1,14 @@
 (ns clojure.core.contracts.impl.utils
   (:require [clojure.core.unify :as unify]))
 
+(defn keys-apply [f ks m]
+  (let [only (select-keys m ks)]
+    (zipmap (keys only) (map f (vals only)))))
 
-(defn build-condition-body
-  [p body prefix-msg]
-  (unify/subst
-   {'?P      p
-    '?PREFIX prefix-msg
-    '?BODY   body}
-
-   '(try
-      ((fn [] {?P ?PRE}
-         ?BODY))
-      (catch AssertionError ae
-        (throw (AssertionError. (str ?PREFIX ?MSG \newline (.getMessage ae))))))))
 
+(defn manip-map [f ks m]
+  (conj m (keys-apply f ks m)))
 
-(defn- build-pre-post-map
-  [cnstr]
-  (if (vector? cnstr)
-    (let [[L M R] (partition-by #{'=>} cnstr)]
-      {:pre  (vec (when (not= L '(=>)) L))
-       :post (vec (if (= L '(=>)) M R))})
-    cnstr))
-
-(comment
-
-  (build-pre-post-map '[(odd? n) (pos? n) => (int? %)])
-
-)
 
 (defmacro ^:private assert-w-message
   [check message]