Mercurial > dylan

annotate mtg/frame.clj @ 2:b4de894a1e2e

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