Sigrid Solveig Haflínudóttirdefstruct: separate slot setters from accessorse12b2831 year agoHistory
165 lines · 4.5 KB · Text
RawDownload
(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))

Keyboard shortcuts

General

Show keyboard shortcuts
?
Focus the current search
/

Issues and pull requests

Open filters
f

Issues, pull requests and Inbox

Select next item
j↓
Select previous item
k↑
Open selected item
Enter
Dismiss filters or clear selection
Esc

Repository code

Go to file
t