Mercurial > dylan
comparison mtg/frame.clj @ 2:b4de894a1e2e
initial import
| author | Robert McIntyre <rlm@mit.edu> |
|---|---|
| date | Fri, 28 Oct 2011 00:03:05 -0700 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| 1:8d8278e09888 | 2:b4de894a1e2e |
|---|---|
| 1 (ns mtg.frame) | |
| 2 | |
| 3 ;; GENERALLY USEFUL FUNCTIONS | |
| 4 | |
| 5 (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] | |
| 6 (reduce #(if ((first %2) x) (conj %1 (second %2))) '() pred-vals) | |
| 7 ) | |
| 8 (defn alter-val "Applies f to the current value associated with each key, associating each key with the value returned." [m f & keys] | |
| 9 (map #(assoc m % (f (get m %))) keys)) | |
| 10 | |
| 11 (defn every-nth "Returns every nth member of coll. If n is not positive, returns an empty list." [n coll] | |
| 12 (if (<= n 0) '() | |
| 13 (take-while (comp not nil?) (map first (iterate #(nthnext % n) coll))))) | |
| 14 | |
| 15 | |
| 16 | |
| 17 | |
| 18 | |
| 19 ;; FRAME MANIPULATION | |
| 20 | |
| 21 (defn conj-key "Adds the xs to the seq associated with the given key." [map key & xs] | |
| 22 (assoc map key (apply conj (get map key []) xs))) | |
| 23 | |
| 24 (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." | |
| 25 [frame & kfs] | |
| 26 (let [id (gensym "") | |
| 27 keys (every-nth 2 kfs) | |
| 28 fns (every-nth 2 (rest kfs))] | |
| 29 | |
| 30 ((reduce comp (map (fn[k f](fn[m](conj-key m k (list id f)))) keys fns)) | |
| 31 (conj-key frame :*bindings* (map (fn [k f](list id k)) keys fns)) | |
| 32 ) | |
| 33 )) | |
| 34 | |
| 35 (defn rollback "Undo the update with the given id." [frame id] | |
| 36 (let [affected-keys | |
| 37 (conj (map second (filter #(=(first %) id) (:*bindings* frame))) :*bindings*)] | |
| 38 (reduce (fn[frame key] | |
| 39 (alter-val (partial filter #(=(first %) id)) key) | |
| 40 ) frame affected-keys) | |
| 41 )) | |
| 42 | |
| 43 | |
| 44 (defn get-fn "Keys in a frame store lists of modifiers. Produces the end result of applying all the modifiers in order." [frame key] | |
| 45 (reduce #(%2) (constantly nil) (list (constantly 1))) | |
| 46 ) | |
| 47 | |
| 48 | |
| 49 (def *frame* (atom {:*bindings* '()})) | |
| 50 |