Update of /project/cells/cvsroot/arccells In directory clnet:/tmp/cvs-serv5046

Modified Files: arccells-its-alive.arc Log Message: Use defset on slot writers to support (= (myslt x) 42)

--- /project/cells/cvsroot/arccells/arccells-its-alive.arc 2008/02/19 02:38:06 1.1 +++ /project/cells/cvsroot/arccells/arccells-its-alive.arc 2008/02/19 17:08:42 1.2 @@ -53,15 +53,20 @@ cells nil ,@(mappend (fn (sd) (list (carif sd)(cadrif sd))) slot-defs)) ; define readers - ,@(map (fn (sd) - `(def ,(coerce (+ (string pfx) (string sd)) 'sym) (i) - (slot-value i ',sd))) - (map carif slot-defs)) - ; define writers - ,@(map (fn (sd) - `(def ,(coerce (+ "set-" (string pfx) (string sd)) 'sym) (i v) - (set-slot-value i ',sd v))) - (map carif slot-defs)))) + ,@(mappend (fn (sd) + (withs (rdr$ (+ (string pfx) (string sd)) + rdr (coerce rdr$ 'sym) + wrtr (coerce (+ "set-" rdr$) 'sym)) + `((def ,rdr (i) + (slot-value i ',sd)) + (def ,wrtr (i v) + (set-slot-value i ',sd v)) + (defset ,rdr (x) + (w/uniq g + (list (list g x) + `(,',rdr ,g) + `(fn (val) (,',wrtr ,g val)))))))) + (map carif slot-defs))))

;;; --- model initialization

@@ -97,8 +102,8 @@ (slot-ensure-current it) (slot-value-observe i k v 'unbound))))))))

-(def md? (name) - mds*.name) +(mac md? (name) + `(mds* ',name))

;; --- start of cells stuff ------------------

@@ -142,7 +147,7 @@ (do (when caller* (pushnew caller* it!users) (pushnew it caller*!useds)) - (slot-ensure-current it)) + slot-ensure-current.it) (i s)))

(def calculate-and-set (c) @@ -157,7 +162,7 @@ (unless c!useds ; losing rules with no dependencies ; is a big performance win - (optimize-away c)) + optimize-away.c) (slot-value-assume c nv)))

(def optimize-away (c) @@ -165,16 +170,16 @@ (each user c!users (pull c user!useds) (unless user!useds ; rarely happens - (optimize-away user)))) + optimize-away.user)))

(def slot-ensure-current (c) ; It would be fun to figure out a more readable ; version of the next consition. I tried, can't. (when (and c!rule (or (is 0 c!pulse-last-changed) - (no (or (is c!pulse datapulse*) - (no (any-used-changed c c!useds)))))) - (calculate-and-set c)) + ~(or (is c!pulse datapulse*) + (~any-used-changed c c!useds)))) + calculate-and-set.c)

(= c!pulse datapulse*)

@@ -187,8 +192,8 @@ (when useds ; So happens that FIFO is better order for this (or (any-used-changed c (cdr useds)) - (let used (car useds) - (slot-ensure-current used) + (let used car.useds + slot-ensure-current.used (> used!pulse-last-changed c!pulse)))))

;;; --- writing to a slot ----------------------- @@ -216,7 +221,7 @@ (def slot-propagate (c ov) (let caller* nil (each user c!users - (slot-ensure-current user)) + slot-ensure-current.user) (slot-value-observe c!model c!slot c!cache ov)))

(def slot-value-observe (i s v ov) @@ -226,8 +231,8 @@ (observe obs*.s i s v ov))

(def observe (o i s v ov) - (if (acons o) - (map (fn (o2) (o2 i s v ov)) o) + (if acons.o + (map [_ i s v ov] o) o (o i s v ov)))

;;; --- constructor sugar -------------------- @@ -263,8 +268,8 @@ (list (imd th42 (thermostat) preferred (c-in 70) actual 70) (imd f-1 (furnace) - fuel 10 - on (c? [let th (md? 'th42) + fuel 10 ;; unused for now + on (c? [let th (md? th42) (< (thermo-actual th)(thermo-preferred th))] ; an instance-level observer (fn (i s v ov) @@ -275,7 +280,7 @@ ;;; obs*!on)

(prt "After awakening the model the furnace is" (if (fur-on f) 'on 'off)) - (set-thermo-preferred th 72) ;; the furnace comes on cuz we want it warmer + (= (thermo-preferred th) 72) ;; the furnace comes on cuz we want it warmer )))

(test-furnace)