ref: 6fa012aa03257194eff87fd048ec93fac1656e6c
parent: 1905d7b14ebe2c8020b05d1a490bf0b6c6dbdb38
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sun Apr 13 23:30:48 EDT 2025
defstruct: fix explicit struct's :type specification Simplify vec vs list handling a bit.
--- a/src/system.sl
+++ b/src/system.sl
@@ -1047,7 +1047,7 @@
(def (S struct . rest)
(apply (getprop struct 'constructor) rest))
-(defmacro (defstruct name (:type vec)
+(defmacro (defstruct name (:type 'vec)
(:named NIL)
(:constructor T)
(:conc-name NIL)
@@ -1128,7 +1128,7 @@
; and keywords for names
[slots-kw (tokw slots)]
; underlying type, either a vector or list
- [isvec (eq? type vec)]
+ [isvec (eq? type 'vec)]
; struct's predicate name
[is? (and predicate
(if (eq? predicate T)
@@ -1155,7 +1155,7 @@
(str hd
"\n\n "
(append (list 'defstruct)
- (unless (eq? type vec) (list :type type))
+ (unless isvec (list :type type))
(unless named (list :named named))
(unless constructor (list :constructor constructor))
(if conc-name (list :conc-name conc-name))
@@ -1176,16 +1176,18 @@
num-slots))])))
; constructor
,(when constructor
- `(begin (def ,constructor
- (,type
- ,@(and isvec (list ''%struct%))
- ',named
- ,@(if isvec
- (foldr (λ (s z) (cons (sym ":" s) (cons s z)))
- NIL
- slots-car)
- slots-car)))
- (putprop ',name 'constructor ,(car constructor))))
+ (if isvec
+ `(begin
+ (def ,constructor
+ (,type '%struct%
+ ',name
+ ,@(foldr (λ (s z) (cons (sym ":" s) (cons s z)))
+ NIL
+ slots-car)))
+ (putprop ',name 'constructor ,(car constructor)))
+ `(def ,constructor
+ ,(if named `(list ',named ,@slots-car)
+ `(list ,@slots-car)))))
; accessor per slot
,@(map-int (λ (i) [let* {[opts (slot-opts (list-ref slots-kw i))][fld (list-ref slots-car i)]