define-struct

[kinghajj]

Somebody mentioned wanting a defstruct macro in newLISP, so here's my attempt at implementing one.

Code: Select all

(define (truncate lst size)
	(let ((len (length lst)))
		(if (<= len size)
			(append lst (dup nil (- size len)))
			(chop lst (- len size)))))

(define-macro (define-struct params)
	(let ((items (args))
	      (struct-name (params 0)))
		(eval (expand (quote
			(define (struct-name)
				(truncate (args) n)))
			(list
				(list 'struct-name struct-name)
				(list 'n (length items)))))
		(dolist (item items)
			(eval (expand (quote
				(define (item-getter-setter struct value)
					(if value
						(set-nth idx struct value)
						(struct idx))))
				(list
					(list 'item-getter-setter (sym (string struct-name "-" item)))
					(list 'idx $idx)))))))

Here's an example usage.

Code: Select all

(define-struct (point) x y z)
(setq point1 (point 2 4 6))
(println "point1 = (" (point-x point1) "," (point-y point1) "," (point-z point1) ")")

[rickyboy]

Oops:

Code: Select all

> (define-struct (point) x y z)
> (setq p (point 2 4 6))
(2 4 6)
> p
(2 4 6)
> (point-x p 42)
(42 4 6)
> p
(2 4 6)

[Lutz]

The setter doesn't work, but you can make it work changing your definition of item-getter-setter to a macro:

Code: Select all

 (define-macro (item-getter-setter struct value) 
    (if (set 'value (eval value)) 
        (set-nth idx (eval struct) value) 
        ((eval struct) idx))) 

Lutz

ps: did a small correction

[kinghajj]

Thanks, Lutz. I was wondering this morning how to do that, and using a macro did come to mind, but I was too busy to work on that.

[Lutz]

Here is an extreme concise definition of the same algorithm ;-)

Code: Select all

(define-macro (define-struct)
  (set (args 0 0) (lambda () (args)))
  (dolist (item (rest (args)))
    (set (sym (string (args 0 0) "-" item))
      (expand '(lambda-macro (struct value)
                 (if (set 'value (eval value))
                   (set-nth $idx (eval struct) value)   
                   ((eval struct) $idx))) '$idx))))	

Code: Select all

(define-struct (point) x y z) 
(setq point1 (point 2 4 6)) => (2 4 6)
(point-z point1) => 6
(point-z point1 99) => (2 4 99)
point1 => (2 4 99)

Lutz