defstruct for xlisp? 
Author Message
 defstruct for xlisp?

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





Thu, 29 Jun 1995 04:13:02 GMT  
 defstruct for xlisp?
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

****************************************************************

;;; -*- 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

                   (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

              (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)))))



Sat, 15 Jul 1995 09:18:56 GMT  
 
 [ 2 post ] 

 Relevant Pages 

1. defstruct for xlisp

2. XLISP, XLISP-PLUS and XLISP-STAT

3. defstruct slots (was a free lisp for winnt? (+ a defstruct question))

4. Type-checking and defstruct

5. defstruct SRFI?

6. A defstruct package

7. defstruct and defclass

8. Strange defstruct behavoir (?)

9. DEFSTRUCT: NEED TO RECOMPILE ?

10. sorting on defstruct slot

11. evaluation of defstruct slot initforms

12. removing a DEFSTRUCT structure

 

 
Powered by phpBB® Forum Software