diff options
| -rw-r--r-- | geiser/introspection.scm | 43 | 
1 files changed, 14 insertions, 29 deletions
| diff --git a/geiser/introspection.scm b/geiser/introspection.scm index efe9a09..62d3ce5 100644 --- a/geiser/introspection.scm +++ b/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 | 
