(defstruct sa a b (c 3))(assert (bound? 'make-sa)) ; default constructor is defined(assert (bound? 'sa-a)) ; slot accessors are defined(assert (bound? 'sa-b))(assert (bound? 'sa-c))(assert (bound? 'sa-a!)) ; slot setters are defined(assert (bound? 'sa-b!))(assert (bound? 'sa-c!))(assert (bound? 'sa?))(def ax (make-sa))(assert (sa? ax))(assert (not (vec? ax)))(assert (not (cons? ax)))(assert (equal? (type-of ax) '(struct sa)))(assert (not (equal? #('sa :a NIL :b NIL :c 3) ax)))(assert (not (eqv? #('sa :a NIL :b NIL :c 3) ax)))(assert (not (sa-a ax))) ; a defaults to NIL(assert (not (sa-b ax))) ; so is b(assert (= (sa-c ax) 3))(def ax (make-sa :a 1 :b 2))(assert (sa? ax))(assert (= (sa-a ax) 1))(assert (= (sa-b ax) 2))(assert (= (sa-c ax) 3))(sa-c! ax 4)(sa-b! ax 5)(sa-a! ax 6)(assert (= (sa-a ax) 6))(assert (= (sa-b ax) 5))(assert (= (sa-c ax) 4))(def ax (make-sa :c 0))(assert (sa? ax))(assert (not (sa-a ax)))(assert (not (sa-b ax)))(assert (= (sa-c ax) 0)) ; same struct, different name(defstruct sb a b (c 3))(def bx (make-sb))(assert (sb? bx))(assert (not (sa? bx)))(assert (not (vec? bx)))(assert (not (cons? bx)))(assert (equal? (type-of bx) '(struct sb))) ; struct as a list, NOT named(defstruct sl :type list a b (c 3))(def lx (make-sl))(assert (not (bound? 'sl?))) ; not :named, should not have a predicate(assert (cons? lx))(assert (length= lx 3)) ; 3 slots, not named by default(assert (not (sl-a lx)))(assert (not (sl-b lx)))(assert (= (sl-c lx) 3))(sl-a! lx lx)(assert (eq? (sl-a lx) lx)) ; struct as a list, named(defstruct sln :type list :named T a b (c 3))(def lx (make-sln))(assert (bound? 'sln?)) ; :named, should have a predicate defined(assert (cons? lx))(assert (length= lx 4)) ; 4 slots (with the name)(assert (not (sln-a lx)))(assert (not (sln-b lx)))(assert (= (sln-c lx) 3))(sl-a! lx lx)(assert (eq? (sl-a lx) lx)) (defstruct ok :named T a)(assert-fail (macroexpand '(defstruct fail :named NIL a))) ; custom constructor - renamed(defstruct scc :constructor scc_ a b (c 3))(assert (not (bound? 'make-scc)))(assert (bound? 'scc_))(assert (bound? 'scc?))(def ccx (scc_ :a 1 :b 2))(assert (= (scc-a ccx) 1))(assert (= (scc-b ccx) 2))(assert (= (scc-c ccx) 3))(let ((b (buffer))) ; able to read the #S(...) form with a renamed constructor (write ccx b) (io-pos! b 0) (assert (equal? (read b) ccx))) ; custom constructor - no keywords(defstruct scc2 :constructor (scc2 a b c) a b (c 3))(assert (not (bound? 'make-scc2)))(assert (bound? 'scc2))(assert (bound? 'scc2?))(def cc2x (scc2 1 2 4))(assert (= (scc2-a cc2x) 1))(assert (= (scc2-b cc2x) 2))(assert (= (scc2-c cc2x) 4))(let ((b (buffer))) ; able to read the #S(...) form with a custom constructor (write cc2x b) (io-pos! b 0) (assert (equal? (read b) cc2x))) ; no predicate(defstruct snp :predicate NIL x)(assert (not (bound? 'snp?)))(def snpv (make-snp :x 1))(assert (= (snp-x snpv) 1))(snp-x! snpv 0)(assert (= (snp-x snpv) 0)) ; renamed predicate(defstruct scp :predicate isit? x)(assert (not (bound? 'scp?)))(assert (bound? 'isit?))(def scpv (make-scp :x 1))(assert (isit? scpv))(assert (not (isit? snpv)))(assert (= (scp-x scpv) 1))(snp-x! scpv 0)(assert (= (scp-x scpv) 0)) ; unnamed, list - can't ask fot a predicate(assert-fail (macroexpand '(defstruct fail :type list :predicate T a)))(assert-fail (macroexpand '(defstruct fail :type list :predicate fail? a))) ; named list, no predicate(defstruct lnp :named T :predicate NIL a)(assert (not (bound? 'lnp?)))(def lnpv (make-lnp :a 1))(assert (= (lnp-a lnpv) 1)) ; named list, renamed predicate(defstruct lcp :named T :predicate eh? a)(assert (not (bound? 'lcp?)))(assert (bound? 'eh?))(def lcpv (make-lcp :a 1))(assert (= (lcp-a lcpv) 1))(assert (eh? lcpv))(assert (not (eh? lnpv))) ; renamed conc-name(defstruct scn :conc-name scn/ a b)(assert (bound? 'scn/a))(assert (not (bound? 'scn-a)))(assert (bound? 'scn/b))(assert (not (bound? 'scn-b)))(def scnv (make-scn :a 1 :b 2))(assert (= (scn/a scnv) 1))(assert (= (scn/b scnv) 2)) ; NIL conc-name(defstruct sncn :conc-name NIL aaa bbb)(assert (bound? 'aaa))(assert (not (bound? 'sncn-a)))(assert (bound? 'bbb))(assert (not (bound? 'sncn-b)))(def sncnv (make-sncn :aaa 2 :bbb 3))(assert (= (aaa sncnv) 2))(assert (= (bbb sncnv) 3)) ; read-only slots(defstruct sro (a NIL :read-only T) b)(def srov (make-sro :a 1 :b 2))(assert (not (bound? 'sro-a!)))(assert (= (sro-a srov) 1))(sro-b! srov 1)(assert (= (sro-b srov) 1))
(defstruct sa a b (c 3))
(assert (bound? 'make-sa)) ; default constructor is defined
(assert (bound? 'sa-a)) ; slot accessors are defined
(assert (bound? 'sa-b))
(assert (bound? 'sa-c))
(assert (bound? 'sa-a!)) ; slot setters are defined
(assert (bound? 'sa-b!))
(assert (bound? 'sa-c!))
(assert (bound? 'sa?))
(def ax (make-sa))
(assert (sa? ax))
(assert (not (vec? ax)))
(assert (not (cons? ax)))
(assert (equal? (type-of ax) '(struct sa)))
(assert (not (equal? #('sa :a NIL :b NIL :c 3) ax)))
(assert (not (eqv? #('sa :a NIL :b NIL :c 3) ax)))
(assert (not (sa-a ax))) ; a defaults to NIL
(assert (not (sa-b ax))) ; so is b
(assert (= (sa-c ax) 3))
(def ax (make-sa :a 1 :b 2))
(assert (sa? ax))
(assert (= (sa-a ax) 1))
(assert (= (sa-b ax) 2))
(assert (= (sa-c ax) 3))
(sa-c! ax 4)
(sa-b! ax 5)
(sa-a! ax 6)
(assert (= (sa-a ax) 6))
(assert (= (sa-b ax) 5))
(assert (= (sa-c ax) 4))
(def ax (make-sa :c 0))
(assert (sa? ax))
(assert (not (sa-a ax)))
(assert (not (sa-b ax)))
(assert (= (sa-c ax) 0))
; same struct, different name
(defstruct sb a b (c 3))
(def bx (make-sb))
(assert (sb? bx))
(assert (not (sa? bx)))
(assert (not (vec? bx)))
(assert (not (cons? bx)))
(assert (equal? (type-of bx) '(struct sb)))
; struct as a list, NOT named
(defstruct sl :type list a b (c 3))
(def lx (make-sl))
(assert (not (bound? 'sl?))) ; not :named, should not have a predicate
(assert (cons? lx))
(assert (length= lx 3)) ; 3 slots, not named by default
(assert (not (sl-a lx)))
(assert (not (sl-b lx)))
(assert (= (sl-c lx) 3))
(sl-a! lx lx)
(assert (eq? (sl-a lx) lx))
; struct as a list, named
(defstruct sln :type list :named T a b (c 3))
(def lx (make-sln))
(assert (bound? 'sln?)) ; :named, should have a predicate defined
(assert (cons? lx))
(assert (length= lx 4)) ; 4 slots (with the name)
(assert (not (sln-a lx)))
(assert (not (sln-b lx)))
(assert (= (sln-c lx) 3))
(sl-a! lx lx)
(assert (eq? (sl-a lx) lx))
(defstruct ok :named T a)
(assert-fail (macroexpand '(defstruct fail :named NIL a)))
; custom constructor - renamed
(defstruct scc :constructor scc_ a b (c 3))
(assert (not (bound? 'make-scc)))
(assert (bound? 'scc_))
(assert (bound? 'scc?))
(def ccx (scc_ :a 1 :b 2))
(assert (= (scc-a ccx) 1))
(assert (= (scc-b ccx) 2))
(assert (= (scc-c ccx) 3))
(let ((b (buffer))) ; able to read the #S(...) form with a renamed constructor
(write ccx b)
(io-pos! b 0)
(assert (equal? (read b) ccx)))
; custom constructor - no keywords
(defstruct scc2 :constructor (scc2 a b c) a b (c 3))
(assert (not (bound? 'make-scc2)))
(assert (bound? 'scc2))
(assert (bound? 'scc2?))
(def cc2x (scc2 1 2 4))
(assert (= (scc2-a cc2x) 1))
(assert (= (scc2-b cc2x) 2))
(assert (= (scc2-c cc2x) 4))
(let ((b (buffer))) ; able to read the #S(...) form with a custom constructor
(write cc2x b)
(io-pos! b 0)
(assert (equal? (read b) cc2x)))
; no predicate
(defstruct snp :predicate NIL x)
(assert (not (bound? 'snp?)))
(def snpv (make-snp :x 1))
(assert (= (snp-x snpv) 1))
(snp-x! snpv 0)
(assert (= (snp-x snpv) 0))
; renamed predicate
(defstruct scp :predicate isit? x)
(assert (not (bound? 'scp?)))
(assert (bound? 'isit?))
(def scpv (make-scp :x 1))
(assert (isit? scpv))
(assert (not (isit? snpv)))
(assert (= (scp-x scpv) 1))
(snp-x! scpv 0)
(assert (= (scp-x scpv) 0))
; unnamed, list - can't ask fot a predicate
(assert-fail (macroexpand '(defstruct fail :type list :predicate T a)))
(assert-fail (macroexpand '(defstruct fail :type list :predicate fail? a)))
; named list, no predicate
(defstruct lnp :named T :predicate NIL a)
(assert (not (bound? 'lnp?)))
(def lnpv (make-lnp :a 1))
(assert (= (lnp-a lnpv) 1))
; named list, renamed predicate
(defstruct lcp :named T :predicate eh? a)
(assert (not (bound? 'lcp?)))
(assert (bound? 'eh?))
(def lcpv (make-lcp :a 1))
(assert (= (lcp-a lcpv) 1))
(assert (eh? lcpv))
(assert (not (eh? lnpv)))
; renamed conc-name
(defstruct scn :conc-name scn/ a b)
(assert (bound? 'scn/a))
(assert (not (bound? 'scn-a)))
(assert (bound? 'scn/b))
(assert (not (bound? 'scn-b)))
(def scnv (make-scn :a 1 :b 2))
(assert (= (scn/a scnv) 1))
(assert (= (scn/b scnv) 2))
; NIL conc-name
(defstruct sncn :conc-name NIL aaa bbb)
(assert (bound? 'aaa))
(assert (not (bound? 'sncn-a)))
(assert (bound? 'bbb))
(assert (not (bound? 'sncn-b)))
(def sncnv (make-sncn :aaa 2 :bbb 3))
(assert (= (aaa sncnv) 2))
(assert (= (bbb sncnv) 3))
; read-only slots
(defstruct sro (a NIL :read-only T) b)
(def srov (make-sro :a 1 :b 2))
(assert (not (bound? 'sro-a!)))
(assert (= (sro-a srov) 1))
(sro-b! srov 1)
(assert (= (sro-b srov) 1))