ref: 10ce12b59ef284066aa81d630feb59d8968cd7bd
parent: 748752d6f0e9ff71381c02a2f46a59777b0f8c54
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Thu Mar 13 17:45:23 EDT 2025
symbol-set-doc: filter out duplicates
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -16,8 +16,7 @@
(data :size
decompressed-bytes)) void? ((x)) >= ((a . rest)) defstruct ((name
doc options... (slot-1 DEFAULT) slot-2 (slot-3 :read-only))
- (name (:type vector) (:named T) (:constructor T) (:conc-name NIL) (:predicate NIL) . slots)
- (name doc options... (slot-1 DEFAULT) slot-2 (slot-3 :read-only))) help ((term)) length= ((lst
+ (name (:type vector) (: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) * ((number…)) 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." __finish "A function called right before exit by the VM." 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." 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." 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\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@@ -411,8 +410,9 @@
#fn(string-char) 1+) trim-start) #fn("n3E82L23R020121072825152523?0A<0172825163:82:" #(#fn(string-find)#fn(string-char) 1-) trim-end) #fn(string-length)
#fn(string-sub)) string-trim)
- symbol-set-doc #fn("z213=070021153@30q482B3J0700222374022q53825253@30q47560:" #(putprop- *doc* *funvars* #fn(append) getprop void) symbol-set-doc)
+ symbol-set-doc #fn("z213=070021153@30q482B3\\072023q53742587>18252700232687885253^1^1@30q47760:" #(putprop+ *doc* getprop *funvars* filter #fn("n1700A52S:" #(member))+ #fn(append) void) symbol-set-doc)
symbol-syntax #fn("n120710q63:" #(#fn(get)*syntax-environment*) symbol-syntax)
table-clone #fn("n12050212285>1q053485:" #(#fn(table)--- a/src/system.lsp
+++ b/src/system.lsp
@@ -125,8 +125,11 @@
(when doc
(putprop sym '*doc* doc))
(when (cons? funvars)
- (putprop sym '*funvars* (append (getprop sym '*funvars* nil)
- funvars)))
+ (let* {[existing (getprop sym '*funvars* nil)]+ ; filter out duplicates
+ [to-add (filter (λ (funvar) (not (member funvar existing)))
+ funvars)]}
+ (putprop sym '*funvars* (append existing to-add))))
(void))
;; chicken and egg - properties defined before symbol-set-doc