Permalink
Browse files

Use robert.hooke instead of alter-var-root

  • Loading branch information...
1 parent c3c66cf commit 48af6dc9fd6bc7d0268c6f4e4ef08b2574572f1f @dnaumov committed May 18, 2012
Showing with 14 additions and 11 deletions.
  1. +2 −1 project.clj
  2. +12 −10 src/contracts/core.clj
View
@@ -1,7 +1,8 @@
(defproject clojure-contracts "0.0.1-SNAPSHOT"
:description "Contract programming for Clojure."
:dependencies [[org.clojure/clojure "1.3.0"]
- [org.clojure/core.match "0.2.0-alpha9"]]
+ [org.clojure/core.match "0.2.0-alpha9"]
+ [robert/hooke "1.2.0"]]
:dev-dependencies [[midje "1.3.2-SNAPSHOT"]
[lein-midje "1.0.7"]
[lein-marginalia "0.7.0"]])
@@ -3,7 +3,8 @@
(:require [clojure.core :as clj])
(:use contracts.utils
[clojure.core.match :only [match]]
- [clojure.walk :only [postwalk]]))
+ [clojure.walk :only [postwalk]]
+ [robert.hooke :only [add-hook]]))
(def current-target (atom nil))
@@ -137,24 +138,23 @@
(defprotocol Constrained
(check-constraint [this]))
-(defn apply-record-contract [f]
- (fn [& args]
- (let [result (apply f args)]
- (if (satisfies? Constrained result)
+(defn apply-record-contract [f & args]
+ (let [result (apply f args)]
+ (if (satisfies? Constrained result)
(check-constraint result)
- result))))
+ result)))
(comment
(doseq [v [#'assoc #'dissoc #'assoc-in #'update-in
#'conj #'into #'merge #'merge-with]]
- (alter-var-root v apply-record-contract)))
+ (add-hook v #'apply-record-contract)))
(defn gen-constrain-record [class pred]
(let [name (.getSimpleName class)
this (gensym "this")
[factory map-factory] (map #(symbol (str % name)) ["->" "map->"])]
- `(do (alter-var-root (var ~factory) apply-record-contract)
- (alter-var-root (var ~map-factory) apply-record-contract)
+ `(do (add-hook (var ~factory) #'apply-record-contract)
+ (add-hook (var ~map-factory) #'apply-record-contract)
(extend ~class
Constrained
{:check-constraint (fn [~this]
@@ -172,7 +172,9 @@
target)]
(reset! current-target resolved-target)
`(do ~(cond
- (fn-contract-expr? contract) `(alter-var-root (var ~target) ~contract)
+ (fn-contract-expr? contract) `(add-hook (var ~target) ::contract
+ (fn [f# & args#]
+ (apply (~contract f#) args#)))
(class? resolved-target) (gen-constrain-record resolved-target contract)
:else `(set-validator! ~target ~(gen-iref-contract target contract)))
(reset! current-target nil))))

0 comments on commit 48af6dc

Please sign in to comment.