shithub: sl

Download patch

ref: 34b373bc8ffb1570116e1549339d4726373ce76f
parent: 73ca7a98305c1a1fe6be661a876827da5160f5ec
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sat Apr 12 23:39:26 EDT 2025

defstruct: always named for vec, optionally named for lists

--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -18,7 +18,7 @@
   :to destination)
   (data :size decompressed-bytes))  defstruct ((name doc options… (slot-1 DEFAULT) slot-2 (slot-3
   :read-only))
-                                               (name (:type vec) (:named T) (:constructor T) (:conc-name
+                                               (name (:type vec) (:named NIL) (:constructor T) (:conc-name
   NIL)
                                                      (:predicate T) . slots))  compare ((x y))  buffer (NIL)  num? ((v))  add-exit-hook ((fun))  rand-float (NIL)  builtin? ((v))  set-car! ((cell
   new-first))  cons? ((v))  doc-group ((group-name doc))  1+ ((n))  aref ((sequence subscript0 . rest))  zero? ((x))  vec (rest)  >= ((a . rest))  sym? ((v))  void? ((x))  length= ((lst
@@ -32,7 +32,7 @@
   (level 0)))  *prompt* (NIL)  eq? ((a b))  getprop ((symbol key (def NIL)))  vm-stats (NIL)  * (rest)  putprop ((symbol
   key val))  io->str ((io)))  *doc* #table(identity "Return `x`."  (doc group vm) "VM-related functions."  bound? "Return `T` if `symbol` has a value associated with it, `NIL` otherwise."  sym-set-doc "Set the documentation for the symbol."  io-eof? "Return `T` if `io` is currently in the \"end of file\" state, `NIL`\notherwise."  < "Return `T` if the arguments are in strictly increasing order (next\none is greater than the previous one).  With a single argument\nthe result is always `T`."  cadr "Shorthand for `(car (cdr cell))`, that is, _first element of the\nsecond element_.\n\nExamples:\n\n    (cadr '(1 2 3)) → 2\n    (cadr '(1))     → NIL\n    (cadr NIL)      → NIL"  nan? "Return `T` if `v` is a floating point representation of NaN, either\nnegative or positive, `NIL` otherwise."  for "Call the function `fn` with a single integer argument, starting from\n`min` and ending with `max`.\n\nExamples:\n\n    (for 0 2 (λ (i) (print (- 2 i)))) → 210"  fixnum? "Return `T` if `v` is of a fixnum type, `NIL` otherwise."  exit "Terminate the process with the specified status.  Does not return.\nThe status is expected to be a string in case of an error.\n\nExamples:\n\n    (exit) ; exit with status 0 (nil on Plan 9)\n    (exit \"error\") ; exit with status 1 (\"error\" on Plan 9)"  (doc
   group compare) "Comparison operators."  (doc group compress) "Compression."  + "Return sum of the arguments or `0` when none specified."  (doc
-  group builtin) "Built-in operators."  div0 "Return the quotient of two numbers.  For non-integers this is\nequivalent to `(div0 (floor a) (floor b))`.  The result is always an\ninteger.\n\nExamples:\n\n    (div0 7 2)     → 3\n    (div0 10 -2)   → -5\n    (div0 6.9 1.9) → 6"  lz-unpack "Return decompressed data previously compressed using lz-pack.\n\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  __finish "A function called right before exit by the VM."  defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values.  If the name as the first element isn't\nrequired, `:named NIL` should be used.  A list can be used instead\nof a vector by adding `:type list` option.\n\nAs an example, the following declaration\n\n    (defstruct blah \"Return stuff.\" :doc-group stuff a b c)\n\nGenerates the default constructor definition and accessors:\n\n    (make-blah (:a NIL) (:b NIL) (:c NIL))\n    (blah-a s)\n    (blah-b s)\n    (blah-c s)\n\nThe constructor can be changed in several ways:\n\n    ; disable the constructor altogether\n    (defstruct blah :constructor NIL a b c)\n    ; only change its name\n    (defstruct blah :constructor blargh a b c)\n    ; rename AND avoid using keywords\n    (defstruct blah :constructor (blah a b c) a b c)\n\nThe option `:conc-name` specifies the slot accessor prefix, which\ndefaults to `name-`.\n\nDefault predicate cab be disabled or its name (`name?`) changed:\n\n    ; use \"blargh?\" instead of \"blah?\"\n    (defstruct blah :predicate blargh? a b c)\n    ; without predicate\n    (defstruct blah :predicate NIL a b c)"  (doc
+  group builtin) "Built-in operators."  div0 "Return the quotient of two numbers.  For non-integers this is\nequivalent to `(div0 (floor a) (floor b))`.  The result is always an\ninteger.\n\nExamples:\n\n    (div0 7 2)     → 3\n    (div0 10 -2)   → -5\n    (div0 6.9 1.9) → 6"  lz-unpack "Return decompressed data previously compressed using lz-pack.\n\nEither destination for the decompressed data or the expected size of\nthe decompressed data must be specified.  In the latter case a new\narray is allocated."  > "Return `T` if the arguments are in strictly decreasing order (previous\none is greater than the next one)."  __finish "A function called right before exit by the VM."  defstruct "Defines a structure type with a specific name and slots.\n\nThe default underlying type is a \"named\" vector (`:type vec`),\nwhere the first element is the name of the structure's type, the\nrest are the slot values.  A list can be used instead of a vector\nby adding `:type list` option, which will not contain the name of\nthe structure by default (can be enabled with `:named T` option).\n\nAs an example, the following declaration\n\n    (defstruct blah \"Return stuff.\" :doc-group stuff a b c)\n\nGenerates the default constructor definition and accessors:\n\n    (make-blah (:a NIL) (:b NIL) (:c NIL))\n    (blah-a s)\n    (blah-b s)\n    (blah-c s)\n\nThe constructor can be changed in several ways:\n\n    ; disable the constructor altogether\n    (defstruct blah :constructor NIL a b c)\n    ; only change its name\n    (defstruct blah :constructor blargh a b c)\n    ; rename AND avoid using keywords\n    (defstruct blah :constructor (blah a b c) a b c)\n\nThe option `:conc-name` specifies the slot accessor prefix, which\ndefaults to `name-`.\n\nDefault predicate cab be disabled or its name (`name?`) changed:\n\n    ; use \"blargh?\" instead of \"blah?\"\n    (defstruct blah :predicate blargh? a b c)\n    ; without predicate\n    (defstruct blah :predicate NIL a b c)"  (doc
   group io) "I/O functionality."  compare "Return -1 if `x` is less than `y`, 0 if equal, and `1` if `y` is\ngreater than `x`.\n\nExamples:\n\n    (compare 'a 'b)   → -1\n    (compare 1 1)     → 0\n    (compare \"b\" \"a\") → 1"  buffer "Return an in-memory buffer for I/O, of `io` type.\n\nA buffer can be used for both reading and writing at the same\ntime."  num? "Return `T` if `v` is of a numerical type, `NIL` otherwise.\n\nNumerical types include floating point, fixnum, bignum, etc.\nNote: ironically, a NaN value is considered a number by this function\nsince it's only testing the _type_ of the value."  add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\n\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) `NIL` on success and a string describing\nan error otherwise."  rand-float "Return a random float on [0.0, 1.0] interval."  builtin? "Return `T` if `v` is a built-in function implemented in C, `NIL`\notherwise.\n\nExamples:\n\n    (builtin? map)         → T\n    (builtin? macroexpand) → NIL"  set-car! "Modify a cons cell (a list) in-place by putting `new-first` as its\nfirst element (head of the list).  Return the modified cons\ncell (list).\n\nExamples:\n\n    (def q '(1 2 3 4 5))\n    (set-car! q 0) → (0 6 7)\n    q              → (0 6 7)"  doc-group "Define documentation for a group."  cons? "Return `T` if `v` is a cons cell, `NIL` otherwise.\n\nExamples:\n\n    (cons? 0)    → NIL\n    (cons? NIL)  → NIL\n    (cons? '(1)) → T"  1+ "Equivalent to `(+ n 1)`."  aref "Return the sequence element specified by the subscripts.  The sequence\ncan be an array, vector, a list.  Multi-dimensional sequences\nof variating types are also supported.\n\nExamples:\n\n    (def a '((1 #(2 (3)) 4)))\n    (aref a 0)     → (1 (2 (3)) 4)\n    (aref a 1)     → index 1 out of bounds\n    (aref a 0 0)   → 1\n    (aref a 0 1 0) → 2\n    (aref a 0 2)   → 4"  *properties* "All properties of symbols recorded with `putprop` are recorded in this table."  vec "Return a vector constructed of the arguments.\n\nExamples:\n\n    (vec)              → #() ; empty vector\n    (vec 1 2.5 \"a\" 'b) → #(1 2.5 \"a\" b)"  >= "Return `T` if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)."  sym? "Return `T` if `v` is a symbol, `NIL` otherwise."  (doc
   group string) "String-related functionality."  void? "Return `T` if `x` is `#<void>`, `NIL` otherwise."  zero? "Return `T` if `x` is zero."  (doc
   group list) "Working with lists."  positive? "Return `T` if `x` is greater than zero."  length= "Perform a bounded length test.\n\nUse this instead of `(= (length lst) n)`, since it avoids unnecessary\nwork and always terminates."  doc-for "Define documentation for a top level term.\n\nIf `term` is a function signature and `doc` is not specified, just\nthe signature will be included in the documentation, without\nreplacing any previously defined.\n\nFirst `doc` argument is supposed to be a string with the description\nof the term.  The following arguments are expected to be optional tag\npairings that provide grouping for multiple symbols and \"see also\"\nreferences.\n\nUseful in cases where setting the documentation for a term can't\n(or not preferred to) be made during the definition of said term.\nOne of those reasons is that the term is a built-in function\nimplemented in C.\n\nExamples:\n\n    (doc-for (func arg (arg2 0))\n      \"Return something about the `arg` and `arg2`.  This is a short\n       description.\n\n       This is the longer description, following the short one.\n\n       Examples:\n\n           (func 0)   → T\n           (func 1 3) → NIL\"\n      :doc-group stuff\n      :doc-see func2)\n    (doc-for (func arg (:another-variant NIL)))"  aset! "Modify the sequence element specified by the subscripts and return the\nnew value.  The sequence can be an array, vector, a list.\nMulti-dimensional sequences of variating types are also supported.\n\nExamples:\n\n    (def a '((1 #(2 (3)) 4)))\n    (aset! a 1 'x)     → index 1 out of bounds\n    (aset! a 0 0 'x)   → x\n    a                  → ((x #(2 (3)) 4))\n    (aset! a 0 1 9)    → 9\n    a                  → ((x #(9 (3)) 4))"  car "Return the first element of a cons cell (head of a list) or `NIL` if\nnot available.\n\nExamples:\n\n    (car NIL)      → NIL\n    (car '(1 2 3)) → 1\n    (car '(1 . 2)) → 1"  *builtins* "VM instructions as closures."  str "Return concatenation of terms formatted as strings.\n\nThis is equivalent to `(princ terms…)`, except the string is\nreturned, rather than printed.\n\nExamples:\n\n    (str \"a\" 'b 1 #(0)) → \"ab1#(0)\""  cons "Return a cons cell containing two arguments.\n\nExamples:\n\n    (cons 1 2)                     → (1 . 2)\n    (cons 1 '(2))                  → (1 2)\n    (cons 1 (cons 2 (cons 3 NIL))) → (1 2 3)"  - "Return the result of subtraction.  With only one argument a\nnegation is performed.\n\nExamples:\n\n    (- 1.5) → -1.5\n    (- 3 2) → 1"  remprop "Remove a property value associated with the symbol."  <= "Return `T` if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)."  rand "Return a random non-negative fixnum on its maximum range."  void "Return the constant `#<void>` while ignoring any arguments.\n\n`#<void>` is mainly used when a function has side effects but does not\nproduce any meaningful value to return, so even though `T` or `NIL` could\nbe returned instead, in case of `#<void>` alone, REPL will not print\nit."  negative? "Return `T` if `x` is negative."  Instructions "VM instructions mapped to their encoded byte representation."  file "Open a file for I/O.\n\nAn `io` object is returned.  Without any modes specified the file\nis opened in read-only mode."  rand-double "Return a random double on interval [0.0, 1.0]."  (doc
@@ -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@30q42B2Ce18D3\x8902D8D2Ee22F8C2Ee22G2H2I8Fe2e22J2K2EEe32I0e2e3e32L2M2Ee2268F5112NC708@@80r28@i2Me3e4e3@30qe18E3j02D8E2B1e12B2Ie12O8F5152e12O12NC708A@;07P2Qq8A535153e3@30qe12O7R2S8;8B8A8G18D8F0>88@525164:" #(#(:constructor
+  "no help for " #fn(str) " " "" " (undefined)"))  defstruct #fn("O10005000*///W1000J7071?14W2000J60q?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;J704171Q;3404084;J:042<02=52I222>18F8E848508?>7?H5148>3G07?02@8>2A8HPe15252@30q42B2Ce18D3\x8d02D8D2Ee22F8C2Ee22G2H2I8Fe2e22J2K2EEe32I0e2e3e32L2M2Ee22N360K@30E12OC708@@80r28@i2Me3e4e3@30qe18E3b02D8E2B1e12I8Fe2e12P12OC708A@;07Q2Rq8A535153e3@30qe12P7S2T8;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,10 +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 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)
+  quote eq? aref = length ,named list #fn(copy-list) foldr #fn("n2202105201PP:" #(#fn(sym) ":"))
+  map-int #fn("n1A<70F052517092052219386529422C600@90r20i2KM23872425Ie2e3953?0269524e2e2@30q272825e2292496360K@30E88Me37:2;85523O02<2=2>2?86e22@2?97e22Ae6e2@G02B2496360K@30E88M25e4e4e4:" #(list-ref
+  #fn(sym) list def s v assert if void? aref 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
@@ -1045,7 +1045,7 @@
 ;;; structs
 
 (defmacro (defstruct name (:type vec)
-                          (:named T)
+                          (:named NIL)
                           (:constructor T)
                           (:conc-name NIL)
                           (:predicate T)
@@ -1054,9 +1054,9 @@
 
    The default underlying type is a "named" vector (`:type vec`),
    where the first element is the name of the structure's type, the
-   rest are the slot values.  If the name as the first element isn't
-   required, `:named NIL` should be used.  A list can be used instead
-   of a vector by adding `:type list` option.
+   rest are the slot values.  A list can be used instead of a vector
+   by adding `:type list` option, which will not contain the name of
+   the structure by default (can be enabled with `:named T` option).
 
    As an example, the following declaration
 
@@ -1141,7 +1141,7 @@
                                slots-kw))
                     constructor))] ; anything else means custom name and args
          ; should the struct name appear as the first element?
-         [named (and named (list name))]
+         [named (and (or named (eq? type vec)) name)]
          ; accessor prefix
          [access (or conc-name
                      (str name "-"))]}
@@ -1168,13 +1168,13 @@
       ,(when is? `(def (,is? s)
                     (and [,type? s]
                          [or (not ',named) (eq? (aref s 0) ',name)]
-                         [= (length s) ,(+ (length named) (if (eq? type 'list)
-                                                              num-slots
-                                                              (* 2 num-slots)))])))
+                         [= (length s) ,(+ (if ',named 1 0) (if (eq? type 'list)
+                                                                 num-slots
+                                                                 (* 2 num-slots)))])))
       ; constructor
       ,(when constructor `(def ,constructor
                             (,type
-                              ',@named
+                              ',named
                               ,@(if (eq? type 'list)
                                     slots-car
                                     (foldr (λ (s z) (cons (sym ":" s) (cons s z)))
@@ -1188,10 +1188,10 @@
                           `(def (,fun s (v #.(void)))
                              ,(when is? `(assert (,is? s)))
                              (if (void? v)
-                                 (aref s ,[+ (length named) iv])
+                                 (aref s ,[+ (if named 1 0) iv])
                                  ,(if (member :read-only opts)
                                       `(error (str "slot " ',fld " in struct " ',name " is :read-only"))
-                                      `(aset! s ,[+ (length named) iv] v))))])
+                                      `(aset! s ,[+ (if named 1 0) iv] v))))])
                  num-slots))))
 
 (doc-for (defstruct name