define-struct

[kinghajj]

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

Code Select Expand


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


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

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

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

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

(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