diff options
Diffstat (limited to 'scheme/plt')
| -rw-r--r-- | scheme/plt/geiser/autodoc.ss | 101 | ||||
| -rw-r--r-- | scheme/plt/geiser/completions.ss | 27 | ||||
| -rw-r--r-- | scheme/plt/geiser/eval.ss | 45 |
3 files changed, 54 insertions, 119 deletions
diff --git a/scheme/plt/geiser/autodoc.ss b/scheme/plt/geiser/autodoc.ss index 73ed24d..c43f8c9 100644 --- a/scheme/plt/geiser/autodoc.ss +++ b/scheme/plt/geiser/autodoc.ss @@ -31,39 +31,32 @@ (eval `(help ,symbol #:from ,mod))))) (eval `(help ,symbol)))) -(define (autodoc form) - (cond ((null? form) #f) - ((symbol? form) (describe-application (list form))) - ((not (pair? form)) #f) - ((not (list? form)) (autodoc (pair->list form))) - ((define-head? form) => autodoc) - (else (autodoc/list form)))) - -(define (autodoc/list form) - (let ((lst (last form))) - (cond ((and (symbol? lst) (describe-application (list lst)))) - ((and (pair? lst) (not (memq (car lst) '(quote))) (autodoc lst))) - (else (describe-application form))))) - -(define (define-head? form) - (define defforms '(-define - define define-values - define-method define-class define-generic define-struct - define-syntax define-syntaxes -define-syntax)) - (and (= 2 (length form)) - (memq (car form) defforms) - (car form))) - -(define (describe-application form) - (let* ((fun (car form)) - (loc (symbol-location* fun)) - (name (car loc)) - (path (cdr loc)) - (sgn (and path (find-signature path name fun)))) - (and sgn - (list (cons 'signature (format-signature fun sgn)) - (cons 'position (find-position sgn form)) - (cons 'module (module-path-name->name path)))))) +(define (autodoc ids) + (if (not (list? ids)) + '() + (map (lambda (id) (or (autodoc* id) (list id))) ids))) + +(define (autodoc* id) + (and + (symbol? id) + (let* ((loc (symbol-location* id)) + (name (car loc)) + (path (cdr loc)) + (sgn (and path (find-signature path name id)))) + (and sgn + `(,id + (name . ,name) + (args ,@(format-signature sgn)) + (module . ,(module-path-name->name path))))))) + +(define (format-signature sign) + (if (signature? sign) + `((required ,@(signature-required sign)) + (optional ,@(signature-optional sign) + ,@(let ((rest (signature-rest sign))) + (if rest (list "...") '()))) + (key ,@(signature-keys sign))) + '())) (define signatures (make-hash)) @@ -71,9 +64,7 @@ (define (find-signature path name local-name) (let ((path (if (path? path) (path->string path) path))) - (hash-ref! (hash-ref! signatures - path - (lambda () (parse-signatures path))) + (hash-ref! (hash-ref! signatures path (lambda () (parse-signatures path))) name (lambda () (infer-signature local-name))))) @@ -167,44 +158,6 @@ (opt-no (- max-val min-val))) (make-signature (args 0 min-val) (args min-val opt-no) '() #f))))) -(define (format-signature fun sign) - (cond ((symbol? sign) (cons fun sign)) - ((signature? sign) - (let ((req (signature-required sign)) - (opt (signature-optional sign)) - (keys (signature-keys sign)) - (rest (signature-rest sign))) - `(,fun - ,@req - ,@(if (null? opt) opt (cons '#:opt opt)) - ,@(if (null? keys) keys (cons '#:key keys)) - ,@(if rest (list '#:rest rest) '())))) - (else #f))) - -(define (find-position sign form) - (if (signature? sign) - (let* ((lf (length form)) - (lf-1 (- lf 1))) - (if (= 1 lf) 0 - (let ((req (length (signature-required sign))) - (opt (length (signature-optional sign))) - (keys (map (lambda (k) (symbol->keyword (if (list? k) (car k) k))) - (signature-keys sign))) - (rest (signature-rest sign))) - (cond ((<= lf (+ 1 req)) lf-1) - ((<= lf (+ 1 req opt)) (if (> opt 0) lf lf-1)) - ((or (memq (last form) keys) - (memq (car (take-right form 2)) keys)) => - (lambda (sl) - (+ 2 req - (if (> opt 0) (+ 1 opt) 0) - (- (length keys) (length sl))))) - (else (+ 1 req - (if (> opt 0) (+ 1 opt) 0) - (if (null? keys) 0 (+ 1 (length keys))) - (if rest 2 0))))))) - 0)) - (define (update-module-cache path . form) (when (and (string? path) (or (null? form) diff --git a/scheme/plt/geiser/completions.ss b/scheme/plt/geiser/completions.ss index 4537feb..15bc081 100644 --- a/scheme/plt/geiser/completions.ss +++ b/scheme/plt/geiser/completions.ss @@ -35,29 +35,10 @@ (filter (lambda (s) (string-prefix? prefix s)) (if sort? (sort lst string<?) lst))) -(define (symbol-completions prefix (context #f)) - (append (filter-prefix prefix - (map symbol->string (local-bindings context)) - #f) - (filter-prefix prefix - (map symbol->string (namespace-mapped-symbols)) - #t))) - -(define (local-bindings form) - (define (body f) (if (> (length f) 2) (cddr f) '())) - (let loop ((form form) (bindings '())) - (cond ((not (pair? form)) bindings) - ((list? (car form)) - (loop (cdr form) (append (local-bindings (car form)) bindings))) - ((and (list? form) (< (length form) 2)) bindings) - ((memq (car form) '(define define* lambda)) - (loop (body form) (append (pair->list (cadr form)) bindings))) - ((and (memq (car form) '(let let* letrec letrec*)) - (list? (cadr form))) - (loop (body form) (append (map car (cadr form)) bindings))) - ((and (eq? 'let (car form)) (symbol? (cadr form))) - (loop (cons 'let (body form)) (cons (cadr form) bindings))) - (else (loop (cdr form) bindings))))) +(define (symbol-completions prefix) + (filter-prefix prefix + (map symbol->string (namespace-mapped-symbols)) + #t)) (define (module-completions prefix) (filter-prefix prefix (module-list) #f)) diff --git a/scheme/plt/geiser/eval.ss b/scheme/plt/geiser/eval.ss index 8022a4c..5ae81ed 100644 --- a/scheme/plt/geiser/eval.ss +++ b/scheme/plt/geiser/eval.ss @@ -46,36 +46,37 @@ (vector-ref (struct->vector e) 0)) (define (set-last-error e) - (set! last-result `((error (key . ,(exn-key e)) - (subr) - (msg . ,(exn-message e)))))) + (set! last-result `((error (key . ,(exn-key e))))) + (display (exn-message e))) -(define (set-last-result v . vs) - (set! last-result `((result ,v ,@vs)))) +(define (write-value v) + (with-output-to-string + (lambda () (write v)))) + +(define (set-last-result . vs) + (set! last-result `((result ,@(map write-value vs))))) (define (eval-in form spec) (set-last-result (void)) - (with-handlers ((exn? set-last-error)) - (update-module-cache spec form) - (call-with-values - (lambda () (eval form (module-spec->namespace spec))) - set-last-result)) - last-result) + (let ((output + (with-output-to-string + (lambda () + (with-handlers ((exn? set-last-error)) + (update-module-cache spec form) + (call-with-values + (lambda () (eval form (module-spec->namespace spec))) + set-last-result)))))) + (append last-result `((output . ,output))))) (define compile-in eval-in) (define (load-file file) - (with-handlers ((exn? set-last-error)) - (let ((current-path (namespace->module-path-name (last-namespace)))) - (update-module-cache file) - (set-last-result - (string-append (with-output-to-string - (lambda () - (load-module file (current-output-port)))) - "done.")) - (load-module (and (path? current-path) - (path->string current-path))))) - last-result) + (let ((current-path (namespace->module-path-name (last-namespace))) + (result (eval-in `(load-module ,file (current-output-port)) + 'geiser/eval))) + (update-module-cache file) + (load-module (and (path? current-path) (path->string current-path))) + result)) (define compile-file load-file) |