ref: 367b98c686a8d044e09f7cf518db7ff8e5d17753
parent: 0e972198b130b4af53ac7a8547bdc265a656d45e
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Apr 17 01:39:25 EDT 2025
sym-set-doc: remove supplied-p from formals
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -13,25 +13,22 @@
#fn("z0700}2:" #(aset!)) NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL NIL #fn("n3012082>1|:" #(#fn("n1A061:"))) NIL NIL NIL NIL NIL NIL NIL NIL #fn("z0700}2:" #(aref)) NIL NIL NIL)*properties* #table(*formals-list* #table(identity ((x)) bound? ((symbol)) sym-set-doc ((symbol
- doc-seq . formals-list)) io-eof? ((io)) < ((a . rest)) cadr ((cell)) sym (term) nan? ((v)) for ((min
- max fn)) fixnum? ((v)) exit (((status NIL))) > ((a . rest)) + (rest) div0 ((a b)) __finish ((status)) lz-unpack ((data
- :to destination)
- (data :size decompressed-bytes)) defstruct ((name doc options… (slot-1 DEFAULT) slot-2 (slot-3
- :read-only))
- (name (:type 'vec)
- (:named NIL named-supplied) (:constructor T)
- (:conc-name NIL)
- (:predicate T predicate-supplied) . slots)) compare ((x
+ doc-seq)) io-eof? ((io)) < ((a)) cadr ((cell)) sym (NIL) nan? ((v)) for ((min max fn)) fixnum? ((v)) exit (((status
+ NIL))) > ((a)) + (NIL) div0 ((a b)) __finish ((status)) lz-unpack ((data :to destination)
+ (data :size
+ decompressed-bytes)) defstruct ((name
+ doc options… (slot-1 DEFAULT) slot-2 (slot-3 :read-only))
+ (name (:type 'vec) (:named NIL) (:constructor T) (:conc-name NIL) (:predicate T))) 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= ((seq
- n)) positive? ((x)) doc-for ((term . doc)) aset! ((sequence subscripts… new-value)) car ((lst)) <= ((a . rest)) str (term) cons ((first
- second)) - ((a . rest)) remprop ((symbol key)) negative? ((x)) rand (NIL) void (rest) file ((path
- (:read NIL) (:write NIL) (:create NIL) (:truncate NIL) (:append NIL))) rand-double (NIL) 1- ((n)) atom? ((value)) cdr ((lst)) vec? ((v)) / ((x . rest)) equal? ((a
- b)) eqv? ((a b)) io? ((term)) eof-object? ((term)) list (rest) apply ((fn arg . rest)) help ((term
- (kind NIL) (:print-header help-print-header))) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) not ((v)) separate-doc-from-body ((body
+ new-first)) cons? ((v)) doc-group ((group-name doc)) 1+ ((n)) aref ((sequence subscript0)) zero? ((x)) vec (NIL) >= ((a)) sym? ((v)) void? ((x)) length= ((seq
+ n)) positive? ((x)) doc-for ((term)) aset! ((sequence subscripts… new-value)) car ((lst)) <= ((a)) str (NIL) cons ((first
+ second)) - ((a)) remprop ((symbol key)) negative? ((x)) rand (NIL) void (NIL) file ((path
+ (:read NIL) (:write NIL) (:create NIL) (:truncate NIL) (:append NIL))) rand-double (NIL) 1- ((n)) atom? ((value)) cdr ((lst)) vec? ((v)) / ((x)) equal? ((a
+ b)) eqv? ((a b)) io? ((term)) eof-object? ((term)) list (NIL) apply ((fn arg)) help ((term
+ (kind NIL) (:print-header help-print-header))) rand-u32 (NIL) = ((a)) rand-u64 (NIL) not ((v)) separate-doc-from-body ((body
(doc NIL))) set-cdr! ((cell new-second)) fn? ((v)) help-print-header ((term sigs (:kind NIL)
(:lpad ""))) lz-pack ((data
- (level 0))) *prompt* (NIL) eq? ((a b)) getprop ((symbol key (def NIL))) vm-stats (NIL) * (rest) putprop ((symbol
+ (level 0))) *prompt* (NIL) eq? ((a b)) getprop ((symbol key (def NIL))) vm-stats (NIL) * (NIL) 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 keyworded slot values. A list with slot values alone\ncan be used instead by adding `:type list` option. The list will\nnot contain the name of the struct by default, which can be\nenabled with `:named T` option.\n\nAs an example, the following declaration\n\n (defstruct blah \"Return stuff.\" :doc-group stuff a b (c 1 cset))\n\nGenerates the default constructor definition and accessors:\n\n (make-blah (:a NIL) (:b NIL) (:c 1 cset))\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 `structname-`.\n\nDefault predicate can be disabled or its name, which defaults to\n`structname?`, 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
@@ -57,10 +54,10 @@
*io-in* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if begin)) defmacro #fn("z17015186<86=873?0710<870=53@30q42223240<e22526e10=e127885153e3e2:" #(separate-doc-from-body sym-set-doc void set-syntax! quote #fn(nconc) λ #fn(copy-list))) time #fn("n1202122e1e2e123024252622e121e32728e5e3e3:" #(let- #:g437 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn("z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)+ #:g440 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 #:g19) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)- car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g406 λ if #fn(nconc) begin #fn(copy-list))) assert-fail #fn("z12021220qe32324e113E0252624e2271<e2e3@30De3e3e2:" #(assert+ car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g409 λ if #fn(nconc) begin #fn(copy-list))) assert-fail #fn("z12021220qe32324e113E0252624e2271<e2e3@30De3e3e2:" #(assert trycatch begin λ e eq? car quote)) 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)@@ -99,7 +96,7 @@
#fn(sym) def s v v-supplied? unless type-error quote if not aref member :read-only error str "slot "
" 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)+ λ #:g432 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)) bcode:sp #fn("n1200r4e3:" #(aref)) bcode:stack #fn("n2200r421220e21e3e4:" #(aset!@@ -110,7 +107,7 @@
sym-set-doc list quote doc group)) receive #fn("z22021q1e32221e10e123825153e3:" #(call-with-valuesλ #fn(nconc)
#fn(copy-list))) unwind-protect #fn("n2202122q1e3e2e1232402225e121e12625e2e4e321e1e3e3:" #(let- #:g430 λ prog1 trycatch #:g431 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for+ #:g433 λ prog1 trycatch #:g434 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;3D040<20Q;3:04710TK62:" #(λ length=) 1arg-lambda?)@@ -479,12 +476,12 @@
1-) trim-end)
#fn(str-length)
#fn(str-sub)) str-trim)
- sym-set-doc #fn("z220151873601@401<87360q@401=21Z3\xb40883\xaf0228823528:<8:=74258<528=;3H04268=5126778=28295351~8=;3?042:2;8>>18<52718;8?P23527<02=8@534893>07<02>8953@30q^1^1^1^1^1^1^1@30q482B3[07?02@527A2B8:>182527<02@2C8:8;5253^1^1@30q47D60:" #(#fn(str?)- str-join #fn(str-split) "\n" any #fn("n1E20051L2;3B04210E5222Q;34040:" #(#fn(str-length)- #fn(str-rune) #\space))
- #fn(length) str-trim " " "" #fn(map) #fn("n170A2105152390220A62:0:" #(<= #fn(length)- #fn(str-sub))) putprop
- *doc* *doc-extra* getprop *formals-list* filter #fn("n1700A52S:" #(member))+ sym-set-doc #fn("z2I2021?751422151883601@401<88360q@401=2387825224Z3\xb40893\xaf0258926528<<8<=77288>528?;3H04298?51297:8?2;2<5351~8?;3?04232=8@>18>52748=8AP26527>02?8B5348:3>07>02@8:53@30q^1^1^1^1^1^1^1@30q48;B3[07A02B527C2D8<>18;527>02B2E8<8=5253^1^1@30q47F60:" #(#0#+ #fn("n12021062:" #(#fn(map) #fn("n10B3:0700r262:0:" #(list-head))) formals-clean)+ #fn(str?) #fn(map) str-join #fn(str-split) "\n" any #fn("n1E20051L2;3B04210E5222Q;34040:" #(#fn(str-length)+ #fn(str-rune) #\space)) #fn(length) str-trim " " "" #fn("n170A2105152390220A62:0:" #(<= #fn(length)+ #fn(str-sub)))
+ putprop *doc* *doc-extra* getprop *formals-list* filter #fn("n1700A52S:" #(member))#fn(append) void) sym-set-doc)
table-clone #fn("n12050212285>1q053485:" #(#fn(table)#fn(table-foldl)
@@ -504,7 +501,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 λ #:g432 write cons quote newline apply void) trace)
+ traced? #fn(set-top-level-value!) eval λ #:g435 write cons quote newline apply void) trace)
traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(fn-code)) #(#fn("z020210P51472504230}2:" #(#fn(write)x newline #.apply))))
type-error #fn("z020210P61:" #(#fn(raise) type-error) type-error) untrace--- a/src/system.sl
+++ b/src/system.sl
@@ -159,9 +159,12 @@
(def (sym-set-doc symbol doc-seq . formals-list)
"Set the documentation for the symbol."
:doc-group doc
+ (def (formals-clean fs)
+ (map (λ (f) (if (cons? f) (list-head f 2) f)) fs))
(let* {[doc-only (str? doc-seq)][doc (if doc-only doc-seq (car doc-seq))]
- [extra (if doc-only NIL (cdr doc-seq))]}
+ [extra (if doc-only NIL (cdr doc-seq))]
+ [formals-list (map formals-clean formals-list)]}
(when (and (bound? 'str-join) doc)
(let* {[lines (str-split doc "\n")][hd (car lines)]