ref: 718ef6cff985a419b3467bdad256bd866e53d772
parent: bb46003e44b4d2a7009f1888771c499a6e660054
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Sat Mar 8 20:51:44 EST 2025
doc-for: support documenting any terms, not just those that have top level value bound
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -15,18 +15,18 @@
*properties* #table(*funvars* #table(*prompt* (NIL) lz-unpack ((data :to destination)
(data :size
decompressed-bytes)) void? ((x)) >= ((a . rest)) help ((term)) length= ((lst
- n)) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) car ((lst)) <= ((a . rest)) /= ((a . rest)) lz-pack ((data
- (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) * ((number…)) rand-double (NIL) cdr ((lst)) + ((number…)) > ((a . rest))) *doc* #table(>= "Return T if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return T if x is #<void>, NIL otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." car "Return the first element of a list or NIL if not available." *builtins* "VM instructions as closures." <= "Return T if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\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." rand "Return a random non-negative fixnum on its maximum range." nan? "Return T if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return T if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Return the tail of a list or NIL if not available." + "Return sum of the numbers or 0 with no arguments." lz-unpack "Return decompressed data previously compressed using lz-pack.\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." help "Display documentation for the specified term, if available." rand-u32 "Return a random integer on [0, 2³²-1] interval." = "Return T if the arguments are equal." rand-u64 "Return a random integer on [0, 2⁶⁴-1] interval." /= "Return T if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." rand-float "Return a random float on [0.0, 1.0] interval." arg-counts "VM instructions mapped to their expected arguments count." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Return T if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
- *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404087R;3904208751;J5048786;35040=863H021222387e212389e2e4e2:21222387e21e3e2:" #(#fn(top-level-value)- void symbol-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)- with-bindings
- *input-stream* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if+ n)) doc-for ((term (doc NIL))) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) car ((lst)) <= ((a . rest)) /= ((a . rest)) lz-pack ((data
+ (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) * ((number…)) rand-double (NIL) cdr ((lst)) + ((number…)) > ((a . rest))) *doc* #table(>= "Return T if the arguments are in non-increasing order (previous\none is greater than or equal to the next one)." void? "Return T if x is #<void>, NIL otherwise." length= "Bounded length test.\nUse this instead of (= (length lst) n), since it avoids unnecessary\nwork and always terminates." doc-for "Define documentation for a top level term.\nIf the optional doc argument is missing and the term is a function\nsignture, adds it to the documentation." car "Return the first element of a list or NIL if not available." *builtins* "VM instructions as closures." <= "Return T if the arguments are in non-decreasing order (previous\none is less than or equal to the next one)." void "Return the constant #<void> while ignoring any arguments.\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." rand "Return a random non-negative fixnum on its maximum range." nan? "Return T if the argument is NaN, regardless of the sign." Instructions "VM instructions mapped to their encoded byte representation." rand-double "Return a random double on [0.0, 1.0] interval." > "Return T if the arguments are in strictly decreasing order (previous\none is greater than the next one)." cdr "Return the tail of a list or NIL if not available." + "Return sum of the numbers or 0 with no arguments." lz-unpack "Return decompressed data previously compressed using lz-pack.\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." help "Display documentation for the specified term, if available." rand-u32 "Return a random integer on [0, 2³²-1] interval." = "Return T if the arguments are equal." rand-u64 "Return a random integer on [0, 2⁶⁴-1] interval." /= "Return T if not all arguments are equal. Shorthand for (not (= …))." lz-pack "Return data compressed using Lempel-Ziv.\nThe data must be an array, returned value will have the same type.\nThe optional level is between 0 and 10. With level 0 a simple LZSS\nusing hashing will be performed. Levels between 1 and 9 offer a\ntrade-off between time/space and ratio. Level 10 is optimal but very\nslow." arg-counts "VM instructions mapped to their expected arguments count." rand-float "Return a random float on [0.0, 1.0] interval." *prompt* "Function called by REPL to signal the user input is required.\nDefault function prints \"#;> \"." cons? "Return T if the value is a cons cell." vm-stats "Print various VM-related information, such as the number of GC calls\nso far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." *properties* "All properties of symbols recorded with putprop are recorded in this table."))
+ *syntax-environment* #table(bcode:nconst #fn("n1200r2e3:" #(aref)) doc-for #fn("\x8710002000W1000J60q?140B86;35040<;J404086;35040=863H020212287e212288e2e4e2:20212287e21e3e2:" #(void+ symbol-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc)+ with-bindings
+ *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- #:g354 time-now prog1 princ "Elapsed time: " - " seconds" *linefeed*)) cond #fn("z0Ib520852185>1_51485<061:" #(#0=#fn("z0I:" #() void)+ #:g352 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 #:g22) cond-clauses->if))) do #fn("z21<2071052207205220230522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)- car cadr #fn("n170051B38071061:0<:" #(cddr caddr)) letrec #:g324 λ if #fn(nconc) begin #fn(copy-list))) mark-label #fn("n22002122e21e4:" #(emit+ 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 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)@@ -36,7 +36,7 @@
*doc* princ newline #fn(for-each) #fn("n17050471A0P61:" #(newline print)) *funvars* "no help for " #fn(string) void)) 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- λ #:g349 if and cons? eq? car quote thrown-value cadr caddr raise)) let* #fn("z10H3E02021e1qe12215153e1:2021e173051e1e1220=B3H02024e10=e12215153e1@301515375051e2:" #(#fn(nconc)+ λ #:g347 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!@@ -45,7 +45,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- #:g350 λ prog1 trycatch #:g351 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for+ #:g348 λ prog1 trycatch #:g349 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?@@ -417,7 +417,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 λ #:g352 write cons quote newline apply void) trace)
+ traced? #fn(set-top-level-value!) eval λ #:g350 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/docs_extra.lsp
+++ b/src/docs_extra.lsp
@@ -1,10 +1,13 @@
(defmacro (doc-for term (doc nil))
- (let* ((func (cons? term))
- (sym (or (and func (car term)) term))
- (val (or (and (symbol? sym) (top-level-value sym)) sym))
- (funvars (and func (cdr term))))
- (if func
- `(void (symbol-set-doc ',sym ,doc ',funvars))
+ "Define documentation for a top level term.
+If the optional doc argument is missing and the term is a function
+signture, adds it to the documentation."
+ (let* ((call (cons? term))
+ (sym (or (and call (car term))
+ term))
+ (callvars (and call (cdr term))))
+ (if call
+ `(void (symbol-set-doc ',sym ,doc ',callvars))
`(void (symbol-set-doc ',sym ,doc)))))
(doc-for (= a . rest)