ref: 54c693d34204bae61ed9784bb9e8a8be22606711
parent: 80c38271c97b91da046f8e50bf9fb3abb7dd3fb5
author: spew <spew@cbza.org>
date: Fri Mar 28 20:27:28 EDT 2025
defstruct: add defstruct definition to help documentation
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -64,7 +64,7 @@
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) λ #fn(map) #fn("n10B3500<:0:") #fn(copy-list) #fn("n10B3500T:7060:" #(void)) letrec)) bcode:code #fn("n1200Ee3:" #(aref)) make-label #fn("n120e1:" #(gensym)) bcode:cenv #fn("n1200r3e3:" #(aref)) quasiquote #fn("n1700E62:" #(bq-process)) > #fn("z12021e1721510e163:" #(#fn(nconc)- < reverse)) when #fn("z1200211Pqe4:" #(if begin)) help #fn("O100010003000W1000J60q?14W2000J7071?241;3<0422231520P13;02410e3@3007588265275882752IIIIIb;b<288;29_514288<2:_514282;?=514282<87>1?>514282=??51402>CM02?2@8<>18?2A7B26528=5252@\x12089;J5048:3\xd1082888:2C1544893@07D895147E50@30q475882F527G2H8@528A3W07E5047D2I5147E5042?2J8;>18A5247E50@30q^1^1413c07E5047D2K5147E5042?2L8;>18?2A7B26528>525247E50@30q47M50@g07D2N13<02O12P52@402Q05341JE00R3@00ZJ;07D2R51@30q47E5047M60:" #(#(:print-header+ < reverse)) when #fn("z1200211Pqe4:" #(if begin)) help #fn("O100010003000W1000J60q?14W2000J7071?241;3<0422231520P13;02410e3@3007588265275882752IIIIIb;b<288;29_514288<2:_514282;?=514282<87>1?>514282=??51402>CM02?2@8<>18?2A7B26528=5252@$089;J5048:3\xe3082888:2C154475882D527E2F8@527E2G8@52893H07H7I2J898A535147K50@30q48B3W07K5047H2L5147K5042?2M8;>18B5247K50@30q^1^1^1413c07K5047H2N5147K5042?2O8;>18?2A7B26528>525247K50@30q47P50@g07H2Q13<02R12S52@402T05341JE00R3@00ZJ;07H2U51@30q47K5047P60:" #(#(:print-header0) help-print-header #fn(sym) ":doc-" doc getprop *doc* *formals-list* #0#
#fn("n313?02021820>2162:72504738251474061:" #(#fn(for-each) #fn("n17050471A51472F0P61:" #(newline princ print))@@ -75,19 +75,21 @@
#fn("n27021221>1q0537362:" #(sort #fn(table-foldl) #fn("n3A051370082P:82:") <) table-keys-filter-sort) groups #fn(for-each) #fn("n1707105122A<7302452515347560:" #(princ caddr ": " getprop *doc* newline))- #fn(get) *properties* :kind princ newline *doc-extra* filter #fn("n10<20Q:" #(:doc-see)) "See also:"- #fn("n1A<0=700=21522263:" #(getprop *formals-list* " ")) "Members:" #fn("n1A<070021522263:" #(getprop- *formals-list* " ")) void "no help for " #fn(str) " " "" " (undefined)")) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;J:042902:5283;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=528>3s08E3=02>8E<Pe1@30q8E3I07?8E<2<2@02A53e18?53@30q47?02B8>8H5252^1@30q42C2De12E8D2Fe22G8C2Fe22H2I2J8Fe2e22K2L2FEe32J0e2e3e32M2N2Fe2268F518@Me3e4e3e18E3X02E8E2C1e12C2Je12O8F5152e12O8A5153e3@30qe12O7P2Q8;8B8A8G8D8F0>78@525164:" #(#(:constructor+ #fn(get) *properties* :kind *doc-extra* filter #fn("n10<20Q:" #(:doc-fmt))+ #fn("n10<20Q:" #(:doc-see)) princ foldl #fn("n20=161:") newline "See also:" #fn("n1A<0=700=21522263:" #(getprop+ *formals-list* " ")) "Members:" #fn("n1A<070021522263:" #(getprop *formals-list* " ")) void+ "no help for " #fn(str) " " "" " (undefined)")) defstruct #fn("O10005000*///W1000J7071?14W2000J60D?24W3000J60D?34W4000J60q?44W5000J60q?54z6IIb;228;230>1_5142224?<5147586518=<8==268?5127288?528<8?512912:5285;J:042902:5283;3\\0483H;3M0483DQ;3:04292;052;J504838BP;J5048382;36040e184;J:042<02=52I222>18F8E848508?>7?H5148>3G07?02@8>2A8HPe15252@30q42B2Ce12D8D2Ee22F8C2Ee22G2H2I8Fe2e22J2K2EEe32I0e2e3e32L2M2Ee2268F518@Me3e4e3e18E3X02D8E2B1e12B2Ie12N8F5152e12N8A5153e3@30qe12N7O2P8;8B8A8G8D8F0>78@525164:" #(#(:constructor2 :predicate 4 NIL NIL :type 0 :named 1 :conc-name 3 NIL NIL) vec #0#
#fn("n17005121220A>28552485:" #(cddr #fn(for-each) #fn("n17002152340q:722324A<25F2605661:" #(member (:read-only)error #fn(str) "invalid option in slot "
" of struct " ": "))) slot-opts)
- #fn("n17021062:" #(map! #fn("n10B;35040<85;J404085;35040=;J604qe186RS;J9042086513=071228652@30q423242586522087<51390q87P@408762:" #(#fn(keyword?)+ #fn("n12021062:" #(#fn(map) #fn("n10B;35040<85;J404085;35040=;J604qe186RS;J9042086513=071228652@30q423242586522087<51390q87P@408762:" #(#fn(keyword?)error "invalid slot name: " #fn(list*) #fn(sym) #\:))) tokw) separate-doc-from-body #fn(length)
- #fn(map) #fn("n10B3500<:0:") #fn(sym) #\? "make-" #fn(str) "-" :doc-see sym-set-doc "Constructor for struct `"- "`." #fn(append) #fn(nconc) begin def s and or not quote eq? aref = length #fn(copy-list) map-int
- #fn("n1A<70F0525170920522193865222872324Ie2e3259423e2e2262724e228232995510Me37:2;85523O02<2=2>2?86e22@2?96e22Ae6e2@B02B232995510M24e4e4e4:" #(list-ref+ #fn(map) #fn("n10B3500<:0:") #fn(sym) #\? "make-" #fn(str) "-" #fn("n12002152853=0220E8553@300853<02208552@40232486252627e1A78C60q@7029Ae2F360q@702:Fe292360q@802;92e2933;02<93e2@30q943;02=94e2@30q9596P578764:" #(#fn(str-find)+ "\n\n" #fn(str-sub) "" #fn(str) "\n\n " #fn(append) defstruct vec :type :named :constructor
+ :conc-name :predicate) fmt) sym-set-doc #fn(append) :doc-fmt #fn(nconc) begin def s and or not
+ quote eq? aref = length #fn(copy-list) map-int #fn("n1A<70F0525170920522193865222872324Ie2e3259423e2e2262724e228232995510Me37: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) with-bindings *io-out* #fn(copy-list))) catch #fn("n22012122e123242522e2262722e22829e2e3262:22e20e3e42;22e22<22e2e4e3e3:" #(trycatch--- a/src/system.sl
+++ b/src/system.sl
@@ -247,11 +247,12 @@
doc-group?))
(if (or doc formals-list)
(begin (print-header docterm formals-list :kind kind)
- (when doc
- (princ doc)
- (newline))
(let* {[extra (getprop docterm '*doc-extra*)]+ [fmt (filter (λ (v) (eq? (car v) :doc-fmt)) extra)]
[see (filter (λ (v) (eq? (car v) :doc-see)) extra)]}
+ (when doc
+ (princ (foldl (λ (fmt doc) ((cdr fmt) doc)) doc fmt))
+ (newline))
(when see
(newline)
(princ "See also:")
@@ -1091,20 +1092,20 @@
(def (tokw slots)
; transform args list to keyworded variant.
; eg: (a (b 1) (c :read-only)) → ((:a NIL) (:b 1) (:c NIL :read-only))
- (map! (λ (slot) (let* {[name-cons (and (cons? slot)- (car slot))]
- [name (or name-cons slot)]
- [tail (or (and name-cons
- (cdr slot))
- (list NIL))]}
- (when (or (not (sym? name))
- (keyword? name))
- (error "invalid slot name: " name))
- (list* (sym #\: name)
- (if (keyword? (car tail))
- (cons NIL tail)
- tail))))
- slots))
+ (map (λ (slot) (let* {[name-cons (and (cons? slot)+ (car slot))]
+ [name (or name-cons slot)]
+ [tail (or (and name-cons
+ (cdr slot))
+ (list NIL))]}
+ (when (or (not (sym? name))
+ (keyword? name))
+ (error "invalid slot name: " name))
+ (list* (sym #\: name)
+ (if (keyword? (car tail))
+ (cons NIL tail)
+ tail))))
+ slots))
(let* {; first element in slots may be the doc string[docs+slots (separate-doc-from-body slots)]
[docs (car docs+slots)]
@@ -1135,13 +1136,22 @@
; accessor prefix
[access (or conc-name
(str name "-"))]}
- (when docs
- (let* {[docs-extra (if constructor- (list (cons :doc-see (car constructor))))]}
- (if constructor
- (sym-set-doc (car constructor)
- (list (str "Constructor for struct `" name "`.")) slots))
- (sym-set-doc name (append docs docs-extra))))
+ (def (fmt doc)
+ (let* {[cut (str-find doc "\n\n")]+ [hd (if cut (str-sub doc 0 cut) doc)]
+ [tl (if cut (str-sub doc cut) "")]}
+ (str hd
+ "\n\n "
+ (append (list 'defstruct)
+ (unless (eq? type vec) (list :type type))
+ (unless named (list :named named))
+ (unless constructor (list :constructor constructor))
+ (if conc-name (list :conc-name conc-name))
+ (if predicate (list :predicate predicate))
+ (cons name slots))
+ tl)))
+ (when docs
+ (sym-set-doc name (append docs (list (cons :doc-fmt fmt)))))
`(begin
; predicate
(def (,is? s)