Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added initial contracts macro based on original Trammel version, but …

…with simplified impl
  • Loading branch information...
commit b5485205dae7f35e1b7a460baa4c3b9f3a9d3f01 1 parent 1113015
@fogus fogus authored
View
4 README.md
@@ -4,4 +4,8 @@ Contracts programming for Clojure.
In progress.
+* tolerances
+* generic var rewrite lib
+*
+
Based on [Trammel](http://github.com/fogus/trammel)
View
2  pom.xml
@@ -33,7 +33,7 @@
<dependency>
<groupId>org.clojure</groupId>
<artifactId>core.unify</artifactId>
- <version>0.5.2</version>
+ <version>0.5.3-SNAPSHOT</version>
</dependency>
</dependencies>
View
2  project.clj
@@ -1,7 +1,7 @@
(defproject core.contracts "0.0.1"
:description "Contracts programming for Clojure."
:dependencies [[org.clojure/clojure "1.5.0-alpha1"]
- [org.clojure/core.unify "0.5.2"]]
+ [org.clojure/core.unify "0.5.3-SNAPSHOT"]]
:dev-dependencies [[lein-clojars "0.5.0-SNAPSHOT"]
[jline "0.9.94"]
[swank-clojure "1.4.0"]
View
38 src/main/clojure/clojure/core/contracts.clj
@@ -1,7 +1,39 @@
(ns clojure.core.contracts
- "The public contracts programming functions and macros for clojure.core.contracts.")
+ "The public contracts programming functions and macros for clojure.core.contracts."
+ (:use [clojure.core.contracts.impl.transformers :only (build-contract-fn-body)]))
(defmacro contract
- [n docstring & constraints]
- nil)
+ [name docstring & constraints]
+ (assert (string? docstring) "Sorry, but contracts require docstrings")
+
+ `(with-meta
+ ~(build-contract-fn-body name docstring constraints)
+ {:docstring ~docstring
+ ::constraints :TBD}))
+
+
+(comment
+ (def doubler-contract
+ (contract doubler
+ "ensures dublig"
+ [x] [number? => (= (* 2 x) %)]
+
+ [x y] [(every? number? [x y])
+ =>
+ (= (* 2 (+ x y)) %)]))
+
+ (def x2 (fn f
+ ([n] (* 2 n))
+ ([n x] (+ (f n) (f x)))))
+
+ (def doubler (partial doubler-contract x2))
+
+ (doubler 2)
+ (doubler 2 3)
+
+ (def bad-doubler (partial doubler-contract (comp dec x2)))
+
+ (bad-doubler 2)
+ (bad-doubler 2 3)
+)
View
94 src/main/clojure/clojure/core/contracts/impl/transformers.clj
@@ -4,29 +4,16 @@
[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 [...]}
+(defn- divide-pre-post
+ "'[odd? pos? => int?]
+ =>
+ {:pre (odd? pos?) :post (int?)}
"
[cnstr]
(if (vector? cnstr)
(let [[L M R] (partition-by #{'=>} cnstr)]
- {:pre (vec (when (not= L '(=>)) L))
- :post (vec (if (= L '(=>)) M R))})
+ {:pre (when (not= L '(=>)) L)
+ :post (if (= L '(=>)) M R)})
cnstr))
@@ -38,29 +25,58 @@
form))
cnstr))
-(defn- build-constraints-map
- [args cnstr]
+(defn- build-constraints-description
+ "'[n] '[odd? pos? => int?] \"foo\"
+ =>
+ [[n] {:pre [(pos? n) (int? n)], :post [(neg? %)]} \"foo\"]"
+ [args cnstr docstring]
(let [cnstr (vec (tag-hocs cnstr))]
[args
- (->> (build-pre-post-map cnstr)
+ (->> (divide-pre-post cnstr)
(utils/manip-map (partial funcify '[%]) [:post])
- (utils/manip-map (partial funcify args) [:pre]))]))
+ (utils/manip-map (partial funcify args) [:pre]))
+ docstring]))
+
+(defn- build-condition-body
+ [constraint-map body prefix-msg]
+ (unify/subst
+ '(try
+ ((fn []
+ ?CNSTR
+ ?BODY))
+ (catch AssertionError ae
+ (throw (AssertionError. (str ?PREFIX ?MSG \newline (.getMessage ae))))))
+
+ {'?CNSTR constraint-map
+ '?PREFIX prefix-msg
+ '?BODY body}))
+
+(defn- build-contract-body
+ [[args cnstr descr :as V]]
+ (unify/subst
+ '(?PARMS
+ (let [ret ?PRE-CHECK]
+ ?POST-CHECK))
+
+ {'?ARGS args
+ '?F 'f
+ '?PARMS (vec (list* 'f args))
+ '?MSG descr
+ '?PRE-CHECK (build-condition-body {:pre (:pre cnstr)} '(apply ?F ?ARGS) "Pre-condition failure: ")
+ '?POST-CHECK (build-condition-body {:post (:post cnstr)} 'ret "Post-condition failure: ")}))
+(defn- build-contract-bodies
+ [constraint-descriptions]
+ (for [cnstr constraint-descriptions]
+ (build-contract-body cnstr)))
-(defn build-contract-body
- [args cnstr descr]
- (let [c (build-constraints-map args cnstr)]
- (unify/subst
- {'?ARGS args
- '?F 'f
- '?PARMS (vec (list* 'f args))
- '?PRE (:pre c)
- '?POST (:post c)
- '?MSG descr
- '?PRE-CHECK (build-condition-body :pre '(apply ?F ?ARGS) "Pre-condition failure: ")
- '?POST-CHECK (build-condition-body :post 'ret "Post-condition failure: ")}
-
- '(?PARMS
- (let [ret ?PRE-CHECK]
- ?POST-CHECK)))))
+;; # Public API
+(defn build-contract-fn-body
+ [name docstring raw-constraints]
+ (let [raw-cnstr (partition 2 raw-constraints)
+ cnstr-descrs (for [[a c] raw-cnstr]
+ (build-constraints-description a c docstring))] ;; needs work
+ (->> cnstr-descrs
+ build-contract-bodies
+ (list* `fn name))))
View
8 src/test/clojure/clojure/core/contracts_tests.clj
@@ -1,9 +1,13 @@
(ns clojure.core.contracts-tests
- (:use [clojure.core.contracts :only (contract)])
- (:use [clojure.test :only [deftest is]]))
+ (:use [clojure.core.contracts :only (contract)]
+ [clojure.test :only [deftest is]]
+ clojure.core.contracts.impl.transformers))
(defn defer []
(is (nil? (println "DEFERING TEST!!!"))))
(deftest contracts
(defer))
+
+(deftest regressions
+ (defer))
Please sign in to comment.
Something went wrong with that request. Please try again.