Permalink
Browse files

Added src from ch13

  • Loading branch information...
1 parent 0a6fb06 commit 35ea8fdf1c1349a53cf3261b9099d8b070bcf345 @fogus fogus committed Mar 2, 2011
Showing with 102 additions and 0 deletions.
  1. +21 −0 src/joy/breakpoint.clj
  2. +47 −0 src/joy/measures.clj
  3. +34 −0 src/joy/misc.clj
View
@@ -0,0 +1,21 @@
+(ns joy.breakpoint
+ "The breakpoint example from section 13.4.2"
+ (:use [joy.macros :only [contextual-eval]]))
+
+(defn readr [prompt exit-code]
+ (let [input (clojure.main/repl-read prompt exit-code)]
+ (if (= input ::tl)
+ exit-code
+ input)))
+
+
+(defmacro local-context []
+ (let [symbols (keys &env)]
+ (zipmap (map (fn [sym] `(quote ~sym)) symbols) symbols)))
+
+
+(defmacro break []
+ `(clojure.main/repl
+ :prompt #(print "debug=> ")
+ :read readr
+ :eval (partial contextual-eval (local-context))))
View
@@ -0,0 +1,47 @@
+(ns joy.measures
+ "Units of measure conversion DSL from section 13.1")
+
+(defn relative-units [u units history]
+ (if (some #{u} history)
+ (throw (Exception. (str "Cycle in " u " and " history))))
+ (let [spec (u units)]
+ (if (nil? spec)
+ (throw (Exception. (str "Undefined unit " u)))
+ (if (vector? spec)
+ (let [[conv to] spec]
+ (* conv
+ (relative-units to units [u history])))
+ spec))))
+
+(defmacro defunits-of [quantity base-unit & units]
+ (let [magnitude (gensym)
+ unit (gensym)
+ conversions (into `{~base-unit 1} (map vec (partition 2 units)))]
+ `(defmacro ~(symbol (str "unit-of-" quantity)) [~magnitude ~unit]
+ `(* ~~magnitude
+ ~(case ~unit
+ ~@(mapcat
+ (fn [[u# & r#]]
+ `[~u# ~(relative-units u# conversions [])])
+ conversions))))))
+
+(comment
+ (defunits distance :m
+ :km 1000
+ :cm 1/100
+ :mm [1/10 :cm]
+ :nm [1/1000 :mm]
+
+ :yard 9144/10000
+ :foot [1/3 :yard]
+ :inch [1/12 :foot]
+ :mile [1760 :yard]
+ :furlong [1/8 :mile]
+
+ :fathom [2 :yard]
+ :nautical-mile 1852
+ :cable [1/10 :nautical-mile]
+
+ :old-brit-nautical-mile [6080/3 :yard]
+ :old-brit-cable [1/10 :old-brit-nautical-mile]
+ :old-brit-fathom [1/100 :old-brit-cable]))
View
@@ -134,3 +134,37 @@
0
(/ (int (reduce + sq)) length))))
+
+;; chapter 13
+
+(defn with-redefs-fn [binding-map func & args]
+ (let [root-bind (fn [m]
+ (doseq [[a-var a-val] m] (.bindRoot a-var a-val)))
+ old-vals (zipmap (keys binding-map)
+ (map deref (keys binding-map)))]
+ (try
+ (root-bind binding-map)
+ (apply func args)
+ (finally
+ (root-bind old-vals)))))
+
+(defmacro with-redefs [bindings & body]
+ `(with-redefs-fn ~(zipmap (map #(list `var %) (take-nth 2 bindings))
+ (take-nth 2 (next bindings)))
+ (fn [] ~@body)))
+
+
+(defmacro defformula [nm bindings & formula]
+ `(let ~bindings
+ (let [formula# (agent ~@formula) ;; #: Create formula as Agent
+ update-fn# (fn [key# ref# o# n#]
+ (send formula# (fn [_#] ~@formula)))]
+ (doseq [r# ~(vec (map bindings (range 0 (count bindings) 2)))]
+ (add-watch r# :update-formula update-fn#)) ;; #: Add a watch to each reference
+ (def ~nm formula#))))
+
+(def h (ref 25))
+(def ab (ref 100))
+
+(defformula avg [at-bats ab hits h] ;; #: Create baseball formula
+ (float (/ @hits @at-bats)))

0 comments on commit 35ea8fd

Please sign in to comment.