summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-12 23:33:58 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-12 23:33:58 +0100
commitb20a784d45ac741443e2a2ed6f81178aab93ea63 (patch)
tree594e46b65e242d2b843b0757e79e3a64bd14642c
parentb853bac0c8d7682cf9eae5ffc4d41d6d8caeab6e (diff)
downloadgeiser-guile-b20a784d45ac741443e2a2ed6f81178aab93ea63.tar.gz
geiser-guile-b20a784d45ac741443e2a2ed6f81178aab93ea63.tar.bz2
Better arg lists.
-rw-r--r--geiser/introspection.scm38
1 files changed, 25 insertions, 13 deletions
diff --git a/geiser/introspection.scm b/geiser/introspection.scm
index 7fce4c9..38c0b79 100644
--- a/geiser/introspection.scm
+++ b/geiser/introspection.scm
@@ -30,6 +30,9 @@
#:use-module (ice-9 session)
#:use-module (srfi srfi-1))
+(define (proc-args proc)
+ (obj-args (resolve-symbol proc)))
+
(define (resolve-symbol sym)
(and (symbol? sym)
(module-bound? (current-module) sym)
@@ -52,15 +55,25 @@
(program-module program))))
(define (procedure-args proc)
- (let* ((arity (procedure-property proc 'arity))
- (req (first arity))
- (opt (third arity))
- (env (procedure-environment proc)))
- (format-args (map (lambda (n)
- (string->symbol (format "arg~A" (+ 1 n))))
- (iota req))
- (and opt 'rest)
- (and (not (null? env)) env))))
+ (let ((name (procedure-name proc)))
+ (cond ((procedure-source proc) => (lambda (src)
+ (procedure-args-from-source name src)))
+ (else (let* ((arity (procedure-property proc 'arity))
+ (req (first arity))
+ (opt (third arity)))
+ (format-args (map (lambda (n)
+ (string->symbol (format "arg~A" (+ 1 n))))
+ (iota req))
+ (and opt 'rest)
+ (and name (symbol-module name))))))))
+
+(define (procedure-args-from-source name src)
+ (let ((formals (cadr src)))
+ (cond ((list? formals) (format-args formals #f (symbol-module name)))
+ ((pair? formals) (format-args (car formals)
+ (cdr formals)
+ (symbol-module name)))
+ (else '()))))
(define (macro-args macro)
(let ((prog (macro-transformer macro)))
@@ -71,10 +84,9 @@
(define (format-args args opt module)
(list (cons 'required args)
(cons 'optional (or opt '()))
- (cons 'module (if module (module-name module) '()))))
-
-(define (proc-args proc)
- (obj-args (resolve-symbol proc)))
+ (cons 'module (cond ((module? module) (module-name module))
+ ((list? module) module)
+ (else '())))))
(define (completions prefix)
(sort! (map symbol->string