Arc Forumnew | comments | leaders | submitlogin
3 points by thaddeus 4047 days ago | link | parent

The code is

  1. In bad shape (wrote it early on) 
  2. Includes partial features not fully implemented.
  3. Has references to functions I can not split out without  
     creating a bunch of work.
  4. Includes features you would not care for (datomicish).
  5. Has oddities that make you wonder "why like that",
     until you realize you can pass in say a map of args   
     instead. 
With the above reasons, I was going to say I'll pass on releasing the code, but at long as you're ok just getting the scaffolding that will not run for you then here you go:

  (def index* (ref (hash-map)))
  (def templates* (ref (hash-map)))
  (def mutes* (ref (hash-map)))
  (def selfs* (ref (hash-map)))

  (defmacro deftem [name & fields]
    `(let [tem#   (quote ~name)
	   order# (evens (list ~@fields))
	   fmaps# (apply hash-map (list ~@fields))]
	(dosync (alter templates* assoc tem# fmaps#)
	        (alter index* assoc tem# order#)
	    fmaps#)))

  (defmacro defmute [name & fields]
    `(let [tem#   (quote ~name)
	  items# (list ~@fields)]
      (dosync (alter mutes* assoc tem# items#)
        items#)))

  (defmacro defself [name & fields]
   `(let [tem#   (quote ~name)
	  items# (list ~@fields)]
      (dosync (alter selfs* assoc tem# items#)
        items#)))

  (defn invoke-fields
   ([tem base fields allowables]
     (invoke-fields tem base fields allowables nil))
   ([tem base fields allowables testfn]
    (let [fks   (keys fields)
          selfs (@selfs* tem)]
      (reduce
       (fn [m k]
          (assoc m k
	        (if (detect? k fks); must use 'detect' opposed to 'find' for nil vals must be inserted.
		          (aifn (fields k)
	                  (try (it m)
	                    (catch Exception e (it)))
	                  (let [bfn (base k)]
                      (if (and (detect? k selfs)(fn? bfn))
                          (try (bfn (merge m {k it}))
	                          (catch Exception e (bfn)))
                           it)))
              (aifn (base k)
                    (try (it m)
                         (catch Exception e (it)))
                     it))))
		 (hash-map) allowables))))


  (defn invoke [tem & fields]
    (let [temx  (split-name tem)
          tem1  (first-identity temx)
	  atem? (is (last temx) "+")
	  xfn   (type-fn tem)
          temk  (xfn tem1)
	  base  (@templates* temk)
	  prox  (@mutes* temk)
	  fval  (first fields)
	  fmap  (cond (map? fval) fval ; for file loading map of saved records
	              (coll? fval) (apply hash-map fval)
	           :else (apply hash-map fields))
	  imap  (invoke-fields temk base fmap (@index* temk))]
       (reduce
	   (fn [m [k v]]
		   (if (or (missing? k base)(nil? v)(detect? k prox))
	         (dissoc m k)
		       (assoc m (if atem? (nsify temk k) k) v)))
	   	(hash-map) imap)))