[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/geiser-chez 21d35aa8d6 02/15: autodoc improvements (signat
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/geiser-chez 21d35aa8d6 02/15: autodoc improvements (signatures from arities, values) |
Date: |
Tue, 11 Oct 2022 13:58:54 -0400 (EDT) |
branch: elpa/geiser-chez
commit 21d35aa8d6b2e2b281a773514640fb77586a543c
Author: jao <jao@gnu.org>
Commit: jao <jao@gnu.org>
autodoc improvements (signatures from arities, values)
---
src/geiser/geiser.ss | 107 ++++++++++++++++++++++++---------------------------
1 file changed, 51 insertions(+), 56 deletions(-)
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index 0a7798b3b4..f20434b9cc 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -94,71 +94,66 @@
(substring? prefix el))
(map write-to-string (library-list))))
- (define (procedure-parameter-list p)
+ (define (arity->parameter-list p)
+ (define (nparams n)
+ (map (lambda (n) (string->symbol (format "x~a" n))) (iota n)))
+ (let* ((m (procedure-arity-mask p))
+ (pm (if (< m 0) (+ 1 (lognot m)) m))
+ (n (if (> pm 0) (/ (log pm) (log 2)) 0)))
+ (let loop ((k 1) (pl '()))
+ (cond ((> k n)
+ (reverse (if (< m 0) (cons (append (car pl) '(...)) pl) pl)))
+ ((logbit? k pm) (loop (+ k 1) (cons (nparams k) pl)))
+ (else (loop (+ k 1) pl))))))
+
+ (define (source->parameter-list p)
;; same as (inspect object), then hitting c
- (let ((s (((inspect/object p) 'code) 'source)))
- (if s
- (let ((form (s 'value)))
- (if (and (list? form)
- (>= (length form) 2))
- (case (car form)
- [(lambda) (list (cadr form))]
- [(case-lambda) (map car (cdr form))]
- [(record-predicate record-accessor)
- (list (list (record-type-name (cadr (cadr form)))))]
- [(record-mutator)
- (let ([rtd (cadr (cadr form))]
- [field-idx (caddr form)])
- (list (list (record-type-name rtd)
- (vector-ref (record-type-field-names rtd)
field-idx))))]
- [(record-constructor)
- (let* ([rcd (cadr (cadr form))]
- [rtd (((inspect/object rcd) 'ref 'rtd) 'value)])
- (list (vector->list (record-type-field-names rtd))))]
- [else #f])
- #f))
- #f)))
+ (let* ((s (((inspect/object p) 'code) 'source))
+ (form (and s (s 'value))))
+ (and (list? form)
+ (>= (length form) 2)
+ (case (car form)
+ [(lambda) (list (cadr form))]
+ [(case-lambda) (map car (cdr form))]
+ [(record-predicate record-accessor)
+ (list (list (record-type-name (cadr (cadr form)))))]
+ [(record-mutator)
+ (let ([rtd (cadr (cadr form))]
+ [field-idx (caddr form)])
+ (list (list (record-type-name rtd)
+ (vector-ref (record-type-field-names rtd)
+ field-idx))))]
+ [(record-constructor)
+ (let* ([rcd (cadr (cadr form))]
+ [rtd (((inspect/object rcd) 'ref 'rtd) 'value)])
+ (list (vector->list (record-type-field-names rtd))))]
+ [else #f]))))
(define (operator-arglist operator)
- (define (make-autodoc-arglist arglist)
- (let loop ([arglist arglist]
- [optionals? #f]
- [required '()]
- [optional '()])
- (cond ((null? arglist)
- `(("required" ,@(reverse required))
- ("optional" ,@(reverse optional))
- ("key")
- ;; ("module" ,module)
- ))
- ((symbol? arglist)
- (loop '()
- #t
- required
- (cons "..." (cons arglist optional))))
- (else
- (loop
- (cdr arglist)
- optionals?
- (if optionals? required (cons (car arglist) required))
- (if optionals? (cons (car arglist) optional) optional))))))
- (let ([binding (eval operator)])
+ (define (procedure-parameter-list p)
+ (and (procedure? p)
+ (or (source->parameter-list p)
+ (arity->parameter-list p))))
+ (define (autodoc-arglist* args req)
+ (cond ((null? args) (list (list* "required" (reverse req))))
+ ((pair? args) (autodoc-arglist* (cdr args) (cons (car args) req)))
+ (else `(("required" . ,(reverse req))
+ ("optional" ,args)))))
+ (define (autodoc-arglist arglist) (autodoc-arglist* arglist '()))
+ (let ([binding (with-exception-handler (lambda (e) #f)
+ (lambda () (eval operator)))])
(if binding
(let ([arglists (procedure-parameter-list binding)])
- `(,operator ("args" ,@(map make-autodoc-arglist arglists))))
+ (if arglists
+ `(,operator ("args" ,@(map autodoc-arglist arglists)))
+ `(,operator ("value" . ,(write-to-string binding)))))
'())))
-
(define (geiser:autodoc ids . rest)
(cond ((null? ids) '())
- ((not (list? ids))
- (geiser:autodoc (list ids)))
- ((not (symbol? (car ids)))
- (geiser:autodoc (cdr ids)))
- (else
- (map (lambda (id)
- (operator-arglist id))
- ids))))
+ ((not (list? ids)) (geiser:autodoc (list ids)))
+ ((not (symbol? (car ids))) (geiser:autodoc (cdr ids)))
+ (else (map operator-arglist ids))))
(define (geiser:no-values)
#f)
- [nongnu] elpa/geiser-chez db4d645996 01/15: better display of evaluation results (dups, spurious compile msgs), (continued)
- [nongnu] elpa/geiser-chez db4d645996 01/15: better display of evaluation results (dups, spurious compile msgs), ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 52fbf028e5 04/15: fixes for the above in the face of non-continuable conditions, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez e80f797a5c 10/15: autodoc: fix for arity 0 functions, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 3bfa85afb9 05/15: following the error reporting protocol now that geiser does too, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 7f12bcfe8b 13/15: initial implementation of symbol-location and module-location, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 00ab1e6c7a 12/15: 'module' recognised as a keyword in chez, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 3996898343 14/15: add-to-load-path, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 2d8cd83c64 08/15: wee refactoring, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 501fa22da4 06/15: whitespace and spurious rest arg, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez a70c47c557 07/15: unit test fixes, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 21d35aa8d6 02/15: autodoc improvements (signatures from arities, values),
ELPA Syncer <=
- [nongnu] elpa/geiser-chez 0cd37833ab 03/15: geiser-chez-debug-on-exception-p -> geiser-chez-debug-on-exception, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 39b7e9357d 09/15: remote connections: wee refactoring, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 846f96ba19 11/15: whitespace, ELPA Syncer, 2022/10/11
- [nongnu] elpa/geiser-chez 53b7279550 15/15: load-file: adjust current-directory to loaded file's, ELPA Syncer, 2022/10/11