rjha@castle.ed.ac.uk (R Hamilton) (05/23/91)
I hacked this up to run some lisp code on a PC with Xlisp (V2.0)).
It gives most of defstruct (allows slot defaults in defstruct but no
initialising :keywords in make-structname). I'm no lisp guru and the
code which quotes commas does look a bit iffy (certainly doesnt work in
LUCID!), but it's small and does at least work in xlisp so perhaps
somebody else may find it useful too.
;;; partial defstruct for Xlisp
;;; Robert Hamilton (rjha@uk.ac.ed.ee)
;
;;; doesnt support :keword initialisation in make-structname but allows
;;; defaults in defstruct
;;; uses an array to store the structure
;;; Xlisp only
;;;
(defmacro incf (x) `(setf ,x (+ 1 ,x))) ;need incf
(defmacro defstruct (name &rest parms &aux (counter -1) var)
(setq var (quote ,pppxyz)) ; diddles backquote on xlisp
;; make/eval a list of access macros suitable for setf like:
;; (defmacro name-slot1 (structname) `(aref ,structname slot-number))
(mapcar #'(lambda (x) (eval `(defmacro
,(intern (strcat ; slot-name
(string (car name)) "-"
(if (atom x) (string x)
(string (car x)))))
(pppxyz) ;structure arg
`(aref ,var ,(incf counter)))))
parms)
;; return the make-struct for evaluation
`(defun
,(intern (strcat
(string 'make-) (string (car name))))
()
(prog (template result )
(setq template (quote ,parms))
(setq result (make-array (length template)))
(dotimes (i (length template))
(if (listp (nth i template))
(setf (aref result i)
(cadr (nth i template)))))
(return result))))
Robert Hamilton
Dept of Elect. Engin.
Kings Buildings,
University of Edinburgh
JANET: rjha@uk.ac.ed.ee