Does anyone have Lisp source that implements defstruct functionality in
Xlisp? I've checked the FAQ, ftp.uu.net, cs.cmu.edu, ftp.ai.mit.edu, and
cambridge.apple.com; no luck. There's stuff like this around for Scheme, I'm
surprised it's not readily available for Lisp.
Classes have started;
I'm behind the 8-ball;
I need it bad!
Thanks, Bill
······@ccs.northeastern.edu
··············@uunet.uu.net
here's one. i give it out in my class.
have fun.
-geo
---
George D. Hadden, Honeywell Systems and Research Center
*** Where "Research" is our middle name! ***
3660 Technology Drive, Minneapolis, MN 55418 -- (612)951-7769
······@src.honeywell.com -or- ······@umn-cs.cs.umn.edu
****************************************************************
;;; -*- Package: USER; Mode: LISP; Base: 10; Syntax: Common-Lisp; -*-
;;; public domain version of defstruct
(in-package "USER")
;;;
;;; NOTE: there is nothing fancy here: defaults work;
;;; keywords don't, including ":include", and keyword
;;; initialization.
;;; also,
;;; (defstruct foo a (b 3) c)
;;; (setq xxx (make-foo))
;;; (setf (foo-a xxx) 3) ; this will not work, but
;;; (set-foo-a xxx 3) ; will
;;;
;;; THIS CODE IS NOT GUARANTEED!!!
(defmacro my-defstruct (name &rest field-list)
`(progn
;; first do the make function
(defun ,(intern (strcat "MAKE-" (symbol-name name))) ()
(let ((new-instance (gensym)))
;; add the type info
(putprop new-instance ',name 'structure-type)
;; then do each field
,@(do ((fields field-list (cdr fields))
(result (list 'dummy))) ; don't use backquote here!
((null fields) (cdr result))
(nconc result `(,(if (listp (car fields))
`(putprop
new-instance
,(cadar fields)
',(caar fields))
`(putprop
new-instance
nil
',(car fields))))))
new-instance))
;; do the type predicate
(defun ,(intern (strcat (symbol-name name) "-P")) (instance)
(eq (get instance 'structure-type) ',name))
;; now do accessors and setters for each field
,@(do* ((fields field-list (cdr fields))
(field-name nil)
(result (list 'dummy)))
((null fields) (cdr result)) ; get rid of dummy
(setq field-name (if (listp (car fields))
(caar fields)
(car fields)))
(nconc result
`((defun ,(intern (strcat (symbol-name name)
"-"
(symbol-name field-name)))
(instance)
(get instance ',field-name))
(defun ,(intern (strcat "SET-"
(symbol-name name)
"-"
(symbol-name field-name)))
(instance value)
;; slightly non-standard set, but ok
(setf (get instance ',field-name) value)))))
',name))
;;; the following function is for common lisp
(defun strcat (&rest x)
(let ((foo (car x))
(x (cdr x)))
(dolist (str x foo)
(setq foo (concatenate 'string foo str)))))