🚀 go-pugleaf

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