shithub: sl

Info  •  Files  •  Log  •  Branches

defstruct: include field names in the vector instances

--- a/boot/sl.boot

+++ b/boot/sl.boot

@@ -78,7 +78,7 @@

   #fn(get) *properties* :kind *doc-extra* filter #fn("n10<20Q:" #(:doc-fmt))

   #fn("n10<20Q:" #(:doc-see)) princ foldl #fn("n20=161:") newline "See also:" #fn("n1A<0=700=21522263:" #(getprop

   *formals-list* "    ")) "Members:" #fn("n1A<070021522263:" #(getprop *formals-list* "    ")) void

-  "no help for " #fn(str) " " "" " (undefined)"))  defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60D?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;3E0485DC<02902:52@408583;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=52I222>18F8E848508?>7?H5148>3G07?02@8>2A8HPe15252@30q42B2Ce18D3z02D8D2Ee22F8C2Ee22G2H2I8Fe2e22J2K2EEe32I0e2e3e32L2M2Ee2268F518@Me3e4e3@30qe18E3X02D8E2B1e12B2Ie12N8F5152e12N8A5153e3@30qe12N7O2P8;8B8A8G8D8F0>78@525164:" #(#(:constructor

+  "no help for " #fn(str) " " "" " (undefined)"))  defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60D?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;3E0485DC<02902:52@408583;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=52I222>18F8E848508?>7?H5148>3G07?02@8>2A8HPe15252@30q42B2Ce18D3\x8902D8D2Ee22F8C2Ee22G2H2I8Fe2e22J2K2EEe32I0e2e3e32L2M2Ee2268F5112NC708@@80r28@i2Me3e4e3@30qe18E3j02D8E2B1e12B2Ie12O8F5152e12O12NC708A@;07P2Qq8A535153e3@30qe12O7R2S8;8B8A8G18D8F0>88@525164:" #(#(:constructor

   2 :predicate 4 NIL NIL :type 0 :named 1 :conc-name 3 NIL NIL) vec #0#

   #fn("n17005121220A>28552485:" #(cddr #fn(for-each)

                                   #fn("n17002152340q:722324A<25F2605661:" #(member (:read-only)

@@ -89,9 +89,10 @@

   #fn(map) #fn("n10B3500<:0:") #fn(sym) #\? "make-" #fn(str) "-" #fn("n12002152853=0220E8553@300853<02208552@40232486252627e1A78C60q@7029Ae2F360q@702:Fe292360q@802;92e2933;02<93e2@30q94S;J80494DQS;39042=94e29596P578764:" #(#fn(str-find)

   "\n\n" #fn(str-sub) "" #fn(str) "\n\n    " #fn(append) defstruct vec :type :named :constructor

   :conc-name :predicate) fmt) sym-set-doc #fn(append) :doc-fmt #fn(nconc) begin def s and or not

-  quote eq? aref = length #fn(copy-list) map-int #fn("n1A<70F0525170920522193865222872324Ie2e3943?0259423e2e2@30q262724e228232995510Me37:2;85523O02<2=2>2?86e22@2?96e22Ae6e2@B02B232995510M24e4e4e4:" #(list-ref

-  #fn(sym) def s v assert if void? aref #fn(length) member :read-only error str "slot " quote " in struct "

-  " is :read-only" aset!))))  bcode:ctable #fn("n1200Ke3:" #(aref))  with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)

+  quote eq? aref = length list #fn(copy-list) foldr #fn("n2202105201PP:" #(#fn(sym) ":")) map-int

+  #fn("n1A<70F052517092052219386529422C600@90r20i2KM23872425Ie2e3953?0269524e2e2@30q272825e229242:965188Me37;2<85523O02=2>2?2@86e22A2@97e22Be6e2@C02C242:965188M25e4e4e4:" #(list-ref

+  #fn(sym) list def s v assert if void? aref #fn(length) member :read-only error str "slot " quote

+  " in struct " " is :read-only" aset!))))  bcode:ctable #fn("n1200Ke3:" #(aref))  with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)

   with-bindings *io-out* #fn(copy-list)))  catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch

   λ #:g429 if and cons? eq? car quote thrown-value cadr caddr raise))  let* #fn("z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)

   λ #fn(copy-list) caar let* cadar))  letrec #fn("z1202021e12273052e122240522515154e1227605262:" #(#fn(nconc)

--- a/src/system.sl

+++ b/src/system.sl

@@ -1168,21 +1168,30 @@

       ,(when is? `(def (,is? s)

                     (and [,type? s]

                          [or (not ',named) (eq? (aref s 0) ',name)]

-                         [= (length s) ,(+ (length named) num-slots)])))

+                         [= (length s) ,(+ (length named) (if (eq? type 'list)

+                                                              num-slots

+                                                              (* 2 num-slots)))])))

       ; constructor

       ,(when constructor `(def ,constructor

-                            (,type ',@named ,@slots-car)))

+                            (,type

+                              ',@named

+                              ,@(if (eq? type 'list)

+                                    slots-car

+                                    (foldr (λ (s z) (cons (sym ":" s) (cons s z)))

+                                           NIL

+                                           slots-car)))))

       ; accessor per slot

       ,@(map-int (λ (i) [let* {[opts (slot-opts (list-ref slots-kw i))]

                                [fld (list-ref slots-car i)]

-                               [fun (sym access fld)]}

+                               [fun (sym access fld)]

+                               [iv (if (eq? type 'list) i (+ (* 2 i) 1))]}

                           `(def (,fun s (v #.(void)))

                              ,(when is? `(assert (,is? s)))

                              (if (void? v)

-                                 (aref s ,[+ (length named) i])

+                                 (aref s ,[+ (length named) iv])

                                  ,(if (member :read-only opts)

                                       `(error (str "slot " ',fld " in struct " ',name " is :read-only"))

-                                      `(aset! s ,[+ (length named) i] v))))])

+                                      `(aset! s ,[+ (length named) iv] v))))])

                  num-slots))))

 (doc-for (defstruct name