[cells-cvs] CVS kennysarc

[ktilton]

Update of /project/cells/cvsroot/kennysarc
In directory clnet:/tmp/cvs-serv12716

Added Files:
	struct.arc 
Log Message:
defstruct lite in Arc


--- /project/cells/cvsroot/kennysarc/struct.arc	2008/02/02 22:19:28	NONE
+++ /project/cells/cvsroot/kennysarc/struct.arc	2008/02/02 22:19:28	1.1
;; Same license as Arc

(mac struct ((name (o pfx (string name "-"))) . slot-defs)
  (with (maker (coerce (+ "mk-" (string name)) 'sym)
          defmaker (coerce (+ "mk-def-" (string name)) 'sym)
          fsd (map [if (acons _) _ (list _ nil)] slot-defs))
    `(do
         (def ,defmaker ()
           (listtab ',fsd))

         (def ,maker initargs
           (aif (keep [~find _ ',(map carif slot-defs)] (map car (pair initargs)))
             (do (ero "Invalid initargs to " ',maker " supplied: " it ". Allowed are " ',slot-defs) nil)
             (let self (,defmaker)
               (map [= (self (car _)) (cadr _)] (pair initargs))
               self)))

         ,@(map (fn (sd)
                  `(def ,(coerce (+ (string pfx) (string sd)) 'sym) (self)
                     (self ',sd))) (map carif slot-defs)))))

(prn (macex '(struct (cell c-) awake rule (pulse 0))))

(struct (cell c-)
 awake
 rule
 (pulse 0))

(prn (map [_ (mk-cell 'awake 1 'rule 2 'pulse 3)] (list c-awake c-rule c-pulse)))