ref: 47e10cf9e798843f1a19475bc3d4c54cc070570b
parent: 93cb376f97e98b222f869d7c027ed2fbeed1a240
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Tue Mar 11 20:43:58 EDT 2025
defstruct: autogensym, cons instead of list*
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -26,10 +26,10 @@
*input-stream* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if
begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc
symbol-set-doc void set-syntax! quote #fn(nconc) λ #fn(copy-list))) time #fn("n1202122e1e2e123024252622e121e32728e5e3e3:" #(let
- #:g352 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn("z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)
+ #:g353 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn("z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)
#fn("n10H340q:0<85<20Q;J80485<DQ3C085=J6085<:2185=P:85=J@02285<A<0=51e3:85T23C\x94074758551513c07675855151278685<e2e12886217975855151PA<0=51e4e3:272:85<e2e1282:7585512:e2A<0=51e4e3:2885<2185=PA<0=51e4:" #(else
- begin or => 1arg-lambda? caddr caadr let if cddr #:g20) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)
- car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g322 λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("n22002122e21e4:" #(emit
+ begin or => 1arg-lambda? caddr caadr let if cddr #:g21) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)
+ car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g323 λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("n22002122e21e4:" #(emit
quote label)) with-bindings #fn("z12071052207205220230522425e12076888653e12720288687535129242:e12715152242:e127202;8688535152e3e164:" #(#fn(map)
car cadr #fn("n12060:" #(#fn(gensym))) #fn(nconc) let list #fn(copy-list)
#fn("n22001e3:" #(set!)) unwind-protect begin #fn("n22001e3:" #(set!)))) let #fn("z1q0R3B00?641<?041=?1@30q42021e12223052e124151532225052863C0268687e2e186e3@408788P:" #(#fn(nconc)
@@ -37,7 +37,7 @@
#fn("n10B3500T:7060:" #(void)) letrec)) bcode:code #fn("n1200Ee3:" #(aref)) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) > #fn("z12021e12273151510e163:" #(#fn(nconc)
< #fn(copy-list) reverse!)) when #fn("z1200211Pqe4:" #(if begin)) quasiquote #fn("n1700E62:" #(bq-process)) help #fn("n17002152853W072855147350424250>170026q535247350@B0722728051524735047960:" #(getprop
*doc* princ newline #fn(for-each) #fn("n17050471A0P61:" #(newline print)) *funvars* "no help for "
- #fn(string) void)) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60q?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5142586<51;360486<8=;360486=;J50486268>5127288>528<8>51292:12;525185;J>04292:02;525183;JD042<292:2=052518A5282;36040e184;J:042:02>522?502@2Ae12B8C2Ce22D8B2Ce22E2F2G8Ee2e22H2I2CEe32G0e2e3e32J2K2Ce2268E518?Me3e4e3e12L8=2M2G0e28=e3e3e12B8D2@1e12@2Ge12N8E5152e12N8@5153e3e12N7O2P8;8A8@8F8G8C8E0>88?525165:" #(#(NIL
+ #fn(string) void)) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60q?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5142586<51;360486<8=;360486=;J50486268>5127288>528<8>51292:12;525185;J>04292:02;525183;JA04292:2<052518AP82;36040e184;J:042:02=522>2?e12@8C2Ae22B8B2Ae22C2D2E8Ee2e22F2G2AEe32E0e2e3e32H2I2Ae2268E518?Me3e4e3e12J8=2K2E0e28=e3e3e12@8D2>1e12>2Ee12L8E5152e12L8@5153e3e12L7M2N8;8A8@8F8C8E0>78?525165:" #(#(NIL
NIL :named 1 :conc-name 3 :type 0 NIL NIL NIL NIL NIL NIL :predicate 4 NIL NIL NIL NIL NIL NIL
:constructor 2) vector #0# #fn("n17005121220A>28552485:" #(cddr #fn(for-each)
#fn("n17002152340q:722324A<25F2605661:" #(member
@@ -45,13 +45,12 @@
#fn("n17021062:" #(map! #fn("n10B;35040<85;J404085;35040=;J604qe186RS;J9042086513=071228652@30q4232425268652512087<51390q87P@408762:" #(#fn(keyword?)
error "invalid slot name: " #fn(list*) #fn(symbol)
#fn(string) ":"))) tokw) #fn(string?) #fn(length)
- #fn(map) #fn("n10B3500<:0:" #()) #fn(symbol) #fn(string) "?" #fn(list*) "make-" "-" #fn(gensym)
- #fn(nconc) begin def s and or not quote eq? aref = length when symbol-set-doc #fn(copy-list)
- map-int #fn("n1A<70F052517092052212293865251238724252694e2e2e3279524e2e22829252694e2e32:242;96510Me37<2=85523O02>2?2@2686e22A2697e22Be6e2@B02C242;96510M25e4e4e4:" #(list-ref
- #fn(symbol) #fn(string) def s v quote assert if eq? aref #fn(length) member :read-only error
- string "slot " " in struct " " is :read-only" aset!)))) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)
+ #fn(map) #fn("n10B3500<:0:" #()) #fn(symbol) #fn(string) "?" "make-" "-" #fn(nconc) begin def s
+ and or not quote eq? aref = length when symbol-set-doc #fn(copy-list) map-int #fn("n1A<70F0525170920522122938652512387242526e2e3279424e2e228292526e32:242;95510Me37<2=85523O02>2?2@2A86e22B2A96e22Ce6e2@B02D242;95510M25e4e4e4:" #(list-ref
+ #fn(symbol) #fn(string) def s v #:g388 assert if eq? aref #fn(length) member :read-only error
+ string "slot " quote " in struct " " is :read-only" aset!)))) bcode:ctable #fn("n1200Ke3:" #(aref)) with-output-to #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)
with-bindings *output-stream* #fn(copy-list))) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch
- λ #:g347 if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)
+ λ #:g348 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)
λ #fn(map) car #fn("n12021e12205162:" #(#fn(nconc) set! #fn(copy-list)))
#fn(copy-list) void)) /= #fn("z1202122e10e12315153e2:" #(not #fn(nconc) = #fn(copy-list))) bcode:sp #fn("n1200r4e3:" #(aref)) bcode:stack #fn("n2200r421220e21e3e4:" #(aset!
@@ -60,7 +59,7 @@
eq? quote-value eqv? every symbol? memq quote memv) vals->cond)
#fn(gensym) let #fn(nconc) cond #fn(map) #fn("n1A<F0<520=P:" #()))) receive #fn("z22021q1e32221e10e123825153e3:" #(call-with-values
λ #fn(nconc) #fn(copy-list))) unwind-protect #fn("n2202122q1e3e2e1232402225e121e12625e2e4e321e1e3e3:" #(let
- #:g348 λ prog1 trycatch #:g349 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for
+ #:g349 λ prog1 trycatch #:g350 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for
- #fn(nconc) λ #fn(copy-list))) throw #fn("n220212223e201e4e2:" #(raise list quote thrown-value)))
1+ #fn("n10KM:" #() 1+) 1-
#fn("n10K~:" #() 1-) 1arg-lambda? #fn("n10B;3E04700<51;3:04710TK62:" #(is-lambda?
@@ -434,7 +433,7 @@
#fn("n070A51471225061:" #(print-exception
print-stack-trace #fn(stacktrace))) #fn("n1A50420061:" #(#fn(raise)))) top-level-exception-handler)
trace #fn("n120051718551Jc02207324252627280e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)
- traced? #fn(set-top-level-value!) eval λ #:g350 write cons quote newline apply void) trace)
+ traced? #fn(set-top-level-value!) eval λ #:g351 write cons quote newline apply void) trace)
traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(function:code)) #(#fn("z020210P51472504230}2:" #(#fn(write)
x newline #.apply))))
untrace #fn("n1200517185513C0220238551r3G52@30q^147460:" #(#fn(top-level-value) traced?
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -914,16 +914,12 @@
(symbol (string name "?")))]
; constructor name and arguments
[constructor (or constructor
- (list* (symbol (string "make-" name)) slots-kw))]
+ (cons (symbol (string "make-" name)) slots-kw))]
; should the struct name appear as the first element?
[named (and named (list name))]
; accessor prefix
[access (or conc-name
- (string name "-"))]
- ; FIXME(sigrid): this is only until defset! becomes supported:
- ; use a gensym have a notion of "undefined" default
- ; value in accessors
- [undefined (gensym)]}
+ (string name "-"))]}
`(begin
; predicate
(def (,is? s)
@@ -940,9 +936,9 @@
,@(map-int (λ (i) [let* {[opts (slot-opts (list-ref slots-kw i))]
[fld (list-ref slots-car i)]
[fun (symbol (string access fld))]}
- `(def (,fun s (v ',undefined))
+ `(def (,fun s (v undefined#))
(assert (,is? s))
- (if (eq? v ',undefined)
+ (if (eq? v undefined#)
(aref s ,[+ (length named) i])
,(if (member :read-only opts)
`(error (string "slot "