diff options
Diffstat (limited to 'scheme/racket')
| -rw-r--r-- | scheme/racket/geiser/autodoc.rkt | 66 | ||||
| -rw-r--r-- | scheme/racket/geiser/eval.rkt | 12 | ||||
| -rw-r--r-- | scheme/racket/geiser/main.rkt | 16 | ||||
| -rw-r--r-- | scheme/racket/geiser/modules.rkt | 35 |
4 files changed, 71 insertions, 58 deletions
diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt index ce6553f..e9c6a07 100644 --- a/scheme/racket/geiser/autodoc.rkt +++ b/scheme/racket/geiser/autodoc.rkt @@ -11,9 +11,14 @@ #lang racket -(provide autodoc update-signature-cache get-help) +(provide autodoc module-exports update-signature-cache get-help) -(require geiser/utils geiser/modules geiser/locations scheme/help) +(require racket/help + syntax/modcode + syntax/modresolve + geiser/utils + geiser/modules + geiser/locations) (define (get-help symbol mod) (with-handlers ([exn? (lambda (_) @@ -25,7 +30,7 @@ '() (map (lambda (id) (or (autodoc* id) (list id))) ids))) -(define (autodoc* id) +(define (autodoc* id (extra #t)) (define (val) (with-handlers ([exn? (const "")]) (format "~.a" (namespace-variable-value id)))) @@ -34,13 +39,20 @@ (let* ([loc (symbol-location* id)] [name (car loc)] [path (cdr loc)] - [sgns (and path (find-signatures path name id))]) + [sgns (and path (find-signatures path name id))] + [value (if (and extra sgns (not (list? sgns))) + (list (cons 'value (val))) + '())] + [mod (if (and extra sgns path) + (list (cons 'module + (module-path-name->name path))) + '())]) (and sgns `(,id (name . ,name) - (value . ,(if (list? sgns) "" (val))) (args ,@(if (list? sgns) (map format-signature sgns) '())) - (module . ,(module-path-name->name path))))))) + ,@value + ,@mod))))) (define (format-signature sign) (if (signature? sign) @@ -178,12 +190,44 @@ [(list? arity) (map arity->signature arity)] [else (list (arity->signature arity))])) -(define (update-signature-cache path . form) +(define (update-signature-cache path (form #f)) (when (and (string? path) - (or (null? form) - (and (list? (car form)) - (not (null? (car form))) - (memq (caar form) + (or (not form) + (and (list? form) + (not (null? form)) + (memq (car form) '(define-syntax-rule struct define-syntax define set! define-struct))))) (hash-remove! signatures path))) + +(define (module-exports mod) + (define (value id) + (with-handlers ([exn? (const #f)]) + (dynamic-require mod id (const #f)))) + (define (contracted id) + (let ([v (value id)]) + (if (has-contract? v) + (list id (cons 'info (contract-name (value-contract v)))) + (entry id)))) + (define (entry id) + (let ((sign (eval `(,autodoc* ',id #f) + (module-spec->namespace mod #f #f)))) + (if sign (list id (cons 'signature sign)) (list id)))) + (define (extract-ids ls) + (append-map (lambda (idls) + (map car (cdr idls))) + ls)) + (define (classify-ids ids) + (let loop ([ids ids] [procs '()] [vars '()]) + (cond [(null? ids) + `((procs ,@(map entry (reverse procs))) + (vars ,@(map list (reverse vars))))] + [(procedure? (value (car ids))) + (loop (cdr ids) (cons (car ids) procs) vars)] + [else (loop (cdr ids) procs (cons (car ids) vars))]))) + (let-values ([(reg syn) + (module-compiled-exports + (get-module-code (resolve-module-path mod #f)))]) + (let ([syn (map contracted (extract-ids syn))] + [reg (extract-ids reg)]) + `((syntax ,@syn) ,@(classify-ids reg))))) diff --git a/scheme/racket/geiser/eval.rkt b/scheme/racket/geiser/eval.rkt index 12c77ae..f1f3f51 100644 --- a/scheme/racket/geiser/eval.rkt +++ b/scheme/racket/geiser/eval.rkt @@ -12,14 +12,12 @@ #lang racket (provide eval-in - compile-in load-file - compile-file macroexpand make-repl-reader) -(require geiser/enter geiser/modules geiser/autodoc) +(require geiser/enter geiser/modules) (require errortrace/errortrace-lib) (define last-result (void)) @@ -55,17 +53,11 @@ (define (eval-in form spec lang) (write (call-with-result (lambda () - (update-signature-cache spec form) (eval form (module-spec->namespace spec lang))))) (newline)) -(define compile-in eval-in) - (define (load-file file) - (load-module file (current-output-port) (last-namespace)) - (update-signature-cache file)) - -(define compile-file load-file) + (load-module file (current-output-port) (last-namespace))) (define (macroexpand form . all) (let ([all (and (not (null? all)) (car all))]) diff --git a/scheme/racket/geiser/main.rkt b/scheme/racket/geiser/main.rkt index 4915b68..0c7de4e 100644 --- a/scheme/racket/geiser/main.rkt +++ b/scheme/racket/geiser/main.rkt @@ -32,10 +32,18 @@ geiser/autodoc) (define (geiser:eval lang) - (lambda (form spec) (eval-in form spec lang))) -(define geiser:compile compile-in) -(define geiser:load-file load-file) -(define geiser:compile-file compile-file) + (lambda (form spec) + (update-signature-cache spec form) + (eval-in form spec lang))) + +(define geiser:compile geiser:eval) + +(define (geiser:load-file file) + (update-signature-cache file) + (load-file file)) + +(define geiser:compile-file geiser:load-file) + (define geiser:autodoc autodoc) (define geiser:help get-help) (define geiser:completions symbol-completions) diff --git a/scheme/racket/geiser/modules.rkt b/scheme/racket/geiser/modules.rkt index 0591a92..8e85570 100644 --- a/scheme/racket/geiser/modules.rkt +++ b/scheme/racket/geiser/modules.rkt @@ -18,10 +18,9 @@ namespace->module-path-name module-path-name->name module-spec->path-name - module-list - module-exports) + module-list) -(require srfi/13 syntax/modresolve syntax/modcode geiser/enter) +(require srfi/13 geiser/enter) (define (ensure-module-spec spec) (cond [(symbol? spec) spec] @@ -141,38 +140,8 @@ (update-module-cache) module-cache) -(define (module-exports mod) - (define (value id) - (with-handlers ([exn? (const #f)]) - (dynamic-require mod id (const #f)))) - (define (contracted id) - (let ([v (value id)]) - (if (has-contract? v) - (cons id (contract-name (value-contract v))) - id))) - (define (extract-ids ls) - (append-map (lambda (idls) - (map car (cdr idls))) - ls)) - (define (classify-ids ids) - (let loop ([ids ids] [procs '()] [vars '()]) - (cond [(null? ids) - `((procs ,@(map contracted (reverse procs))) - (vars ,@(map contracted (reverse vars))))] - [(procedure? (value (car ids))) - (loop (cdr ids) (cons (car ids) procs) vars)] - [else (loop (cdr ids) procs (cons (car ids) vars))]))) - (let-values ([(reg syn) - (module-compiled-exports - (get-module-code (resolve-module-path mod #f)))]) - (let ([syn (map contracted (extract-ids syn))] - [reg (extract-ids reg)]) - `((syntax ,@syn) ,@(classify-ids reg))))) - (define (startup) (thread update-module-cache) (void)) (startup) - -;;; modules.rkt ends here |