diff options
| -rw-r--r-- | scheme/guile/geiser/introspection.scm | 43 |
1 files changed, 14 insertions, 29 deletions
diff --git a/scheme/guile/geiser/introspection.scm b/scheme/guile/geiser/introspection.scm index efe9a09..62d3ce5 100644 --- a/scheme/guile/geiser/introspection.scm +++ b/scheme/guile/geiser/introspection.scm @@ -32,13 +32,10 @@ (define (arguments sym . syms) (let loop ((sym sym) (syms syms)) - (cond ((proc-args sym) => (lambda (args) (cons sym args))) + (cond ((obj-args (resolve-symbol sym)) => (lambda (args) (cons sym args))) ((null? syms) #f) (else (loop (car syms) (cdr syms)))))) -(define (proc-args proc) - (obj-args (resolve-symbol proc))) - (define (resolve-symbol sym) (and (symbol? sym) (module-bound? (current-module) sym) @@ -51,6 +48,15 @@ ((macro? obj) (macro-args obj)) (else #f))) +(define (symbol-module sym) + (call/cc + (lambda (k) + (apropos-fold (lambda (module name var init) + (if (eq? name sym) (k (module-name module)) init)) + #f + (symbol->string sym) + (apropos-fold-accessible (current-module)))))) + (define (program-args program) (let* ((arity (program-arity program)) (arg-no (first arity)) @@ -99,38 +105,17 @@ (apropos-internal (string-append "^" prefix))) string<?)) +(define (symbol-location sym) + (cond ((symbol-module sym) => make-location-from-module-name) + (else '()))) + (define (make-location file line) (list (cons 'file (if (string? file) file '())) (cons 'line (if (number? line) (+ 1 line) '())))) -(define (program-line prog) - (let ((src (program-source prog 0))) - (and src (source:line src)))) - (define module-filename (@@ (ice-9 session) module-filename)) -(define (program-file prog) - (let* ((mod (and prog (program-module prog))) - (name (and mod (module-name mod)))) - (and name (module-filename name)))) - -(define (program-location prog) - (make-location (program-file prog) (program-line prog))) - -(define (symbol-module sym) - (call/cc - (lambda (k) - (apropos-fold (lambda (module name var init) - (if (eq? name sym) (k (module-name module)) init)) - #f - (symbol->string sym) - (apropos-fold-accessible (current-module)))))) - (define (make-location-from-module-name name) (make-location (module-filename name) #f)) -(define (symbol-location sym) - (cond ((symbol-module sym) => make-location-from-module-name) - (else '()))) - ;;; introspection.scm ends here |