puck/zilch
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

docs: properly render case-lambda and parameters too

Browse source
This commit is contained in:
puck 2024-10-04 02:29:19 +00:00
parent 998362829a
commit 26444abf95
1 changed files with 36 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

45
docs/docread/docread.scm
View file

@ -42,13 +42,40 @@
(cond
; If we see a preprocessed comment, collect it
((and (list? i) (eq? (car i) 'comment)) (set! comments (cons (cadr i) comments)))
; If we then see either a define or a define-record-type, emit the comments.
((and (list? i) (or (eq? (car i) 'define) (eq? (car i) 'define-record-type)))
(if (list? (cadr i))
; TODO(puck): bad code
(set! defines (cons (cons (car (cadr i)) (cons (cadr i) (reverse comments))) defines))
(set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines)))
; (define-record-type <record-name> ...)
((and (list? i) (eq? (car i) 'define-record-type))
(set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines))
(set! comments '()))
; (define (foo bar baz) quux)
((and (list? i) (eq? (car i) 'define) (list? (cadr i)))
(set! defines (cons (cons (car (cadr i)) (cons (cadr i) (reverse comments))) defines))
(set! comments '()))
; (define foo (make-parameter ...))
((and (list? i) (eq? (car i) 'define) (list? (list-ref i 2)) (eq? (car (list-ref i 2)) 'make-parameter))
(set! defines (cons (cons (cadr i) (cons (list (cadr i)) (reverse comments))) defines))
(set! comments '()))
; (define foo (case-lambda ((bar baz) ...) ((quux aeou) ...) (rest ...)))
((and (list? i) (eq? (car i) 'define) (list? (list-ref i 2)) (eq? (car (list-ref i 2)) 'case-lambda))
(let* ((extra-comments (map (lambda (vp) (if (list? vp) (sprintf "- `++~S++`" (cons (cadr i) (car vp))) (sprintf "- `++~S++`" (cons (cadr i) vp)))) (cdr (list-ref i 2))))
(entries (cdr (list-ref i 2)))
(first-entry-length (length (car entries)))
(last-entry (car (list-ref entries (- (length entries) 1))))
(repr (sprintf "\x28~S" (cadr i))))
(unless (list? last-entry) (set! last-entry (list (sprintf ". ~A" (symbol->string last-entry)))))
(do ((i 0 (+ i 1)) (n last-entry (cdr n)))
((eq? n '()) #f)
(when (>= i (- first-entry-length 1)) (set-car! n (sprintf "[~A]" (symbol->string (car n))))))
(for-each (lambda (v) (set! repr (sprintf "~A ~A" repr v))) last-entry)
(set! defines (cons (cons (cadr i) (cons (string-append repr "\x29") (append extra-comments (list "") (reverse comments)))) defines))
(set! comments '())))
; (define foo ...)
((and (list? i) (eq? (car i) 'define))
(set! defines (cons (cons (cadr i) (cons (cadr i) (reverse comments))) defines))
(set! comments '()))))
(cdr j)))))
contents)
@ -60,13 +87,13 @@
(define out-file (open-output-file out-path))
; Print out the comments
(fprintf out-file "= `~S`\n\n" (car contents))
(fprintf out-file "= `~A`\n\n" (car contents))
(for-each (lambda (l) (fprintf out-file "~A\n" l)) lib-comments)
(fprintf out-file "\n:toc:\n\n")
(for-each (lambda (i)
(define val (assoc i defines))
(unless (eq? val #f)
(fprintf out-file "== `+~S+`\n" (cadr val))
(fprintf out-file "== `+~A+`\n" (cadr val))
(for-each (lambda (l) (fprintf out-file "~A\n" l)) (cddr val))
(fprintf out-file "\n")))
exports)