diff mtg/frame.clj @ 2:b4de894a1e2e

initial import
author Robert McIntyre <rlm@mit.edu>
date Fri, 28 Oct 2011 00:03:05 -0700
parents
children
line wrap: on
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/mtg/frame.clj	Fri Oct 28 00:03:05 2011 -0700
     1.3 @@ -0,0 +1,50 @@
     1.4 +(ns mtg.frame)
     1.5 +
     1.6 +;; GENERALLY USEFUL FUNCTIONS
     1.7 +
     1.8 +(defn assay "Takes x and a series of pred-value pairs. Returns a list of vals for which the corresponding preds are true of x." [x & pred-vals]
     1.9 +  (reduce #(if ((first %2) x) (conj %1 (second %2))) '() pred-vals)
    1.10 +  )
    1.11 +(defn alter-val "Applies f to the current value associated with each key, associating each key with the value returned." [m f & keys]
    1.12 +  (map #(assoc m % (f (get m %))) keys))
    1.13 +
    1.14 +(defn every-nth "Returns every nth member of coll. If n is not positive, returns an empty list." [n coll]
    1.15 +  (if (<= n 0) '()
    1.16 +  (take-while (comp not nil?) (map first (iterate #(nthnext % n) coll)))))
    1.17 +
    1.18 +
    1.19 +
    1.20 +
    1.21 +
    1.22 +;; FRAME MANIPULATION
    1.23 +
    1.24 +(defn conj-key "Adds the xs to the seq associated with the given key." [map key & xs]
    1.25 + (assoc map key (apply conj (get map key []) xs)))
    1.26 +
    1.27 +(defn update "Takes a frame and a sequence of key-fn pairs. Applies f to the current value associated with key, updating the current value with the result.  Frames generate and store a unique id for each call to update."
    1.28 +  [frame & kfs]
    1.29 +  (let [id (gensym "")
    1.30 +	keys (every-nth 2 kfs)
    1.31 +	fns (every-nth 2 (rest kfs))]
    1.32 +
    1.33 +    ((reduce comp (map (fn[k f](fn[m](conj-key m k (list id f)))) keys fns))
    1.34 +    (conj-key frame :*bindings* (map (fn [k f](list id k)) keys fns))
    1.35 +    )
    1.36 +))
    1.37 +
    1.38 +(defn rollback "Undo the update with the given id." [frame id]
    1.39 +  (let [affected-keys
    1.40 +	(conj (map second (filter #(=(first %) id) (:*bindings* frame))) :*bindings*)]
    1.41 +    (reduce (fn[frame key]
    1.42 +	      (alter-val (partial filter #(=(first %) id)) key)
    1.43 +	      ) frame affected-keys)
    1.44 +  ))
    1.45 +
    1.46 +
    1.47 +(defn get-fn "Keys in a frame store lists of modifiers. Produces the end result of applying all the modifiers in order." [frame key]
    1.48 +    (reduce #(%2) (constantly nil) (list (constantly 1)))
    1.49 +)
    1.50 +
    1.51 +
    1.52 +(def *frame* (atom {:*bindings* '()}))
    1.53 +