ref: f141f26d2af52b4f6ac6c81f2824367c63b9e112
parent: 1918b10a5572dda98f4baae03b9c257ee9b16021
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Mon Mar 17 00:41:59 EDT 2025
docstrings: allow more readable in-source indentation
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -18,16 +18,16 @@
doc options... (slot-1 DEFAULT) slot-2 (slot-3 :read-only))
(name (:type vec) (:named T) (:constructor T) (:conc-name NIL) (:predicate NIL) . slots)) help ((term)) length= ((lst
n)) __finish ((status)) doc-for ((term (doc NIL))) rand-u32 (NIL) = ((a . rest)) rand-u64 (NIL) car ((lst)) <= ((a . rest)) add-exit-hook ((fun)) /= ((a . rest)) lz-pack ((data
- (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) rand-double (NIL) * ((num…)) cdr ((lst)) + ((num…)) > ((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." T "A boolean \"true\".\n (not T) → NIL\n (if T 'yes 'no) → 'yes" 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." __finish "A function called right before exit by the VM." help "Display documentation for the specified term, if available." defstruct "Defines a structure type with a specific name and slots.\nThe default underlying type is a named vector, ie the first element is\nthe name of the structure type, the rest are the slot values. If the\nname as the first element isn't required, \":named NIL\" should be\nused. A list can be used instead of a vector by adding \":type list\"\noption.\n\nThe option :conc-name specifies the slot accessor prefix, which\ndefaults to \"name-\".\n\nDefault predicate name (\"name?\") can be changed:\n (defstruct blah :predicate blargh? a b c)" 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." NIL "An empty list. Also used as the opposite of T.\n (not NIL) → T\n (if NIL 'yes 'no) → 'no\n (car NIL) → NIL\n (cdr NIL) → NIL" add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) 0 on success and any other number on\nerror." /= "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." *pr
\ No newline at end of file
+ (level 0))) rand (NIL) nan? ((x)) rand-float (NIL) void (rest) cons? ((value)) vm-stats (NIL) rand-double (NIL) * ((num…)) cdr ((lst)) + ((num…)) > ((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." T "A boolean \"true\".\n(not T) → NIL\n(if T 'yes 'no) → 'yes" 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." __finish "A function called right before exit by the VM." help "Display documentation for the specified term, if available." defstruct "Defines a structure type with a specific name and slots.\nThe default underlying type is a named vector, ie the first element is\nthe name of the structure type, the rest are the slot values. If the\nname as the first element isn't required, \":named NIL\" should be\nused. A list can be used instead of a vector by adding \":type list\"\noption.\n\nThe option :conc-name specifies the slot accessor prefix, which\ndefaults to \"name-\".\n\nDefault predicate name (\"name?\") can be changed:\n\n (defstruct blah :predicate blargh? a b c)" 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." NIL "An empty list. Also used as the opposite of T.\n(not NIL) → T\n(if NIL 'yes 'no) → 'no\n(car NIL) → NIL\n(cdr NIL) → NIL" add-exit-hook "Puts an one-argument function on top of the list of exit hooks.\nOn shutdown each exit hook is called with the exit status as a single\nargument, which is (usually) 0 on success and any other number on\nerror." /= "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 so far, heap and stack size, etc." * "Return product of the numbers or 1 with no arguments." *properties* "All proper
\ No newline at end of file
operties* "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 sym-set-doc quote)) with-input-from #fn("z12021e1220e2e1e12315163:" #(#fn(nconc) with-bindings *io-in* #fn(copy-list))) unless #fn("z1200q211Pe4:" #(if begin)) defmacro #fn("z170151863D0710<860=5341=?1@30q42223240<e22526e10=e12715153e3e2:" #(value-get-doc-n(nconc) λ #fn(copy-list))) time #fn("n1202122e1e2e123024252622e121e32728e5e3e3:" #(let+list))) time #fn("n1202122e1e2e123024252622e121e32728e5e3e3:" #(let " 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-30522425268827872829e12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)
+12:1=51522829e12:82512825e18:52e153e4e3e2e12825e18952e3:" #(#fn(map)
c #:g325 λ 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)@@ -49,7 +49,7 @@
e228232995510Me37:2;85523O02<2=2>2?86e22@2?96e22Ae6e2@B02B232995510M24e4e4e4:" #(list-ref
#fn(sym) 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)-ch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch+242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch
21e1qe12215153e1: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)))@@ -58,7 +58,7 @@
1R3=021072151e3:1H3=023072151e3:1=J>0230721<51e3:74751523=0260271e2e3:280271e2e3:" #(else
eq? quote-value eqv? every sym? memq quote memv) vals->cond)
#fn(gensym) let #fn(nconc) cond #fn(map) #fn("n1A<F0<520=P:" #()))) receive #fn("z22021q1e32221e10e123825153e3:" #(call-with-values-py-list))) unwind-protect #fn("n2202122q1e3e2e1232402225e121e12625e2e4e321e1e3e3:" #(let+otect #fn("n2202122q1e3e2e1232402225e121e12625e2e4e321e1e3e3:" #(let prog1 trycatch #:g352 raise)) dotimes #fn("z10<0T20E2187Ke32223e186e1e12415153e4:" #(for - #fn(nconc) λ #fn(copy-list))) throw #fn("n220212223e201e4e2:" #(raise list quote thrown-value))) 1+ #fn("n10KM:" #() 1+) 1-@@ -410,9 +410,10 @@
82L23R020121072825152523?0A<0172825163:82:" #(#fn(str-find)
#fn(str-char)
1-) trim-end)
- 1-) trim-end)
- #fn(str-length)
- #fn(str-sub)) str-trim)
+m-end)
+ #fn(str-length)
+ #fn(str-sub)) str-trim)
+ sym-set-doc #fn("z220Z3\x9c013\x980211225287<87=89<8:;3H04238:5123748:25265351~8:3A027288;>18952@30q70888<P22527902:8=53^1^1^1^1^1^1^1@30q482B3\\07;02<q537=2>87>182527902<2?87885253^1^1@30q47@60:" #(str-join oc* getprop *funvars* filter #fn("n1700A52S:" #(member))#fn(append) void) sym-set-doc)
table-clone #fn("n12050212285>1q053485:" #(#fn(table)@@ -431,7 +432,7 @@
071w042285>1230>12486>1{86504:" #(*io-out* *stderr* #fn("n0Aw0:" #(*io-out*)) #fn("n070A51471225061:" #(print-exception-8551Jc02207324252627280e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)
+80e225e3e229e12:2885e225e3e55152@30q^147;60:" #(#fn(top-level-value)
ced? #fn(set-top-level-value!) eval λ #:g353 write cons quote newline apply void) trace)
traced? #fn("n170051;3>042105121A51d:" #(closure? #fn(fn-code)) #(#fn("z020210P51472504230}2:" #(#fn(write)x newline #.apply))))
--- a/src/docs_extra.lsp
+++ b/src/docs_extra.lsp
@@ -1,7 +1,7 @@
(defmacro (doc-for term (doc nil))
"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."
+ 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))
@@ -17,23 +17,22 @@
"Return T if the argument is NaN, regardless of the sign.")
(doc-for (vm-stats)
- "Print various VM-related information, such as the number of GC calls
-so far, heap and stack size, etc.")
+ "Print various VM-related information, such as the number of GC calls so far, heap and stack size, etc.")
(doc-for (lz-pack data (level 0))
"Return data compressed using Lempel-Ziv.
-The data must be an array, returned value will have the same type.
-The optional level is between 0 and 10. With level 0 a simple LZSS
-using hashing will be performed. Levels between 1 and 9 offer a
-trade-off between time/space and ratio. Level 10 is optimal but very
-slow.")
+ The data must be an array, returned value will have the same type.
+ The optional level is between 0 and 10. With level 0 a simple LZSS
+ using hashing will be performed. Levels between 1 and 9 offer a
+ trade-off between time/space and ratio. Level 10 is optimal but very
+ slow.")
(doc-for (lz-unpack data :to destination))
(doc-for (lz-unpack data :size decompressed-bytes)
"Return decompressed data previously compressed using lz-pack.
-Either destination for the decompressed data or the expected size of
-the decompressed data must be specified. In the latter case a new
-array is allocated.")
+ Either destination for the decompressed data or the expected size of
+ the decompressed data must be specified. In the latter case a new
+ array is allocated.")
(doc-for (rand)
"Return a random non-negative fixnum on its maximum range.")
@@ -52,12 +51,12 @@
(doc-for NIL
"An empty list. Also used as the opposite of T.
- (not NIL) → T
- (if NIL 'yes 'no) → 'no
- (car NIL) → NIL
- (cdr NIL) → NIL")
+ (not NIL) → T
+ (if NIL 'yes 'no) → 'no
+ (car NIL) → NIL
+ (cdr NIL) → NIL")
(doc-for T
"A boolean \"true\".
- (not T) → NIL
- (if T 'yes 'no) → 'yes")
+ (not T) → NIL
+ (if T 'yes 'no) → 'yes")
--- a/src/str.c
+++ b/src/str.c
@@ -141,7 +141,7 @@
BUILTIN("str-split", str_split) {- if(nargs < 1)
+ if(nargs < 2)
argcount(nargs, 1);
char *s = tostr(args[0]);
usize len = cv_len(ptr(args[0]));
--- a/src/system.lsp
+++ b/src/system.lsp
@@ -6,10 +6,10 @@
(def (void . rest)
"Return the constant #<void> while ignoring any arguments.
-#<void> is mainly used when a function has side effects but does not
-produce any meaningful value to return, so even though T or NIL could
-be returned instead, in case of #<void> alone, REPL will not print
-it."
+ #<void> is mainly used when a function has side effects but does not
+ produce any meaningful value to return, so even though T or NIL could
+ be returned instead, in case of #<void> alone, REPL will not print
+ it."
#.(void))
(def (void? x)
@@ -122,8 +122,20 @@
;;; documentation
(def (sym-set-doc symbol doc . funvars)
- (when doc
- (putprop symbol '*doc* doc))
+ (when (and (bound? 'str-join) doc)
+ (let* {[lines (str-split doc "\n")]+ [hd (car lines)]
+ [tl (cdr lines)]
+ [snd (car tl)]
+ [indent (and snd
+ (- (length snd) (length (str-trim snd " " ""))))]
+ [trimmed (when snd
+ (map (λ (s) (if (<= indent (length s))
+ (str-sub s indent)
+ s))
+ tl))]
+ [final (str-join (cons hd trimmed) "\n")]}
+ (putprop symbol '*doc* final)))
(when (cons? funvars)
(let* {[existing (getprop symbol '*funvars* nil)]; filter out duplicates
@@ -179,7 +191,7 @@
(def (> a . rest)
"Return T if the arguments are in strictly decreasing order (previous
-one is greater than the next one)."
+ one is greater than the next one)."
(let loop ((a a) (rest rest))
(or (not rest)
(and (< (car rest) a)
@@ -189,7 +201,7 @@
(def (<= a . rest)
"Return T if the arguments are in non-decreasing order (previous
-one is less than or equal to the next one)."
+ one is less than or equal to the next one)."
(let loop ((a a) (rest rest))
(or (not rest)
(unless (or (< (car rest) a)
@@ -198,7 +210,7 @@
(def (>= a . rest)
"Return T if the arguments are in non-increasing order (previous
-one is greater than or equal to the next one)."
+ one is greater than or equal to the next one)."
(let loop ((a a) (rest rest))
(or (not rest)
(unless (or (< a (car rest))
@@ -354,8 +366,8 @@
(def (length= lst n)
"Bounded length test.
-Use this instead of (= (length lst) n), since it avoids unnecessary
-work and always terminates."
+ Use this instead of (= (length lst) n), since it avoids unnecessary
+ work and always terminates."
(cond ((< n 0) nil)
((= n 0) (atom? lst))
((atom? lst) (= n 0))
@@ -869,17 +881,18 @@
(:predicate NIL)
. slots)
"Defines a structure type with a specific name and slots.
-The default underlying type is a named vector, ie the first element is
-the name of the structure 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.
+ The default underlying type is a named vector, ie the first element is
+ the name of the structure 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.
-The option :conc-name specifies the slot accessor prefix, which
-defaults to \"name-\".
+ The option :conc-name specifies the slot accessor prefix, which
+ defaults to \"name-\".
-Default predicate name (\"name?\") can be changed:
- (defstruct blah :predicate blargh? a b c)"
+ Default predicate name (\"name?\") can be changed:
+
+ (defstruct blah :predicate blargh? a b c)"
(def (slot-opts slot)
; check whether slot options, if any, are valid
(let ((opts (cddr slot)))
@@ -1289,7 +1302,7 @@
(λ () (princ "#;> ")))))
(set! *prompt*
"Function called by REPL to signal the user input is required.
-Default function prints \"#;> \"." defprompt))
+ Default function prints \"#;> \"." defprompt))
(set! *directory-separator* (or (and (equal? *os-name* "dos") "\\") "/"))
(set! *linefeed* "\n")
(set! *exit-hooks* nil)
@@ -1330,9 +1343,9 @@
(def (add-exit-hook fun)
"Puts an one-argument function on top of the list of exit hooks.
-On shutdown each exit hook is called with the exit status as a single
-argument, which is (usually) 0 on success and any other number on
-error."
+ On shutdown each exit hook is called with the exit status as a single
+ argument, which is (usually) 0 on success and any other number on
+ error."
(set! *exit-hooks* (cons fun *exit-hooks*))
(void))