Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Moving over contract building functions and utils.

  • Loading branch information...
commit eec81d8ddd8fb17f413f82fee943c56a94233135 1 parent fde7014
Fogus fogus authored
39 src/main/clojure/clojure/core/contracts/impl/transformers.clj
View
@@ -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))
+
30 src/main/clojure/clojure/core/contracts/impl/utils.clj
View
@@ -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]
Please sign in to comment.
Something went wrong with that request. Please try again.