From b39fd77d8899bc7ff6608645afc9e2eb0eb0d33c Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 27 Nov 2010 00:54:59 +0100 Subject: No more interning in the scheme reader We avoid using elisp's read for symbols, reading uninterned ones instead. And then, we cannot use symbols as keys in responses from scheme: we're using strings instead. --- scheme/guile/geiser/doc.scm | 29 ++++++++++++++--------------- scheme/guile/geiser/utils.scm | 4 ++-- scheme/guile/geiser/xref.scm | 8 +++----- scheme/racket/geiser/autodoc.rkt | 36 ++++++++++++++++++------------------ scheme/racket/geiser/locations.rkt | 6 +++--- 5 files changed, 40 insertions(+), 43 deletions(-) (limited to 'scheme') diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 640f4ad..ebb8e1d 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -33,7 +33,7 @@ (let ((args (obj-args (symbol->object id)))) (and args `(,@(signature id args) - (module . ,(symbol-module id)))))) + ("module" . ,(symbol-module id)))))) (define (object-signature name obj) (let ((args (obj-args obj))) @@ -49,15 +49,14 @@ ((list? args) args) (else (list args))))) (define (mkargs as) - `((required ,@(arglst as 'required)) - (optional ,@(arglst as 'optional) - ,@(let ((rest (assq-ref as 'rest))) - (if rest (list "...") '()))) - (key ,@(arglst as 'keyword)))) + `(("required" ,@(arglst as 'required)) + ("optional" ,@(arglst as 'optional) + ,@(if (assq-ref as 'rest) (list "...") '())) + ("key" ,@(arglst as 'keyword)))) (let* ((args-list (map mkargs (if (list? args-list) args-list '()))) (value (and (and detail (null? args-list)) (value-str (symbol->object id))))) - `(,id (args ,@args-list) ,@(if value `((value . ,value)) '())))) + `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '())))) (define default-macro-args '(((required ...)))) @@ -186,8 +185,8 @@ (define (symbol-documentation sym) (let ((obj (symbol->object sym))) (if obj - `((signature . ,(or (obj-signature sym obj #f) sym)) - (docstring . ,(docstring sym obj)))))) + `(("signature" . ,(or (obj-signature sym obj #f) sym)) + ("docstring" . ,(docstring sym obj)))))) (define (docstring sym obj) (define (valuable?) @@ -229,23 +228,23 @@ (elts (map elt-sort elts)) (subs (map (lambda (m) (list (module-name m))) (submodules (resolve-module mod-name #f))))) - (list (cons 'modules subs) - (cons 'procs (car elts)) - (cons 'syntax (cadr elts)) - (cons 'vars (caddr elts))))) + (list (cons "modules" subs) + (cons "procs" (car elts)) + (cons "syntax" (cadr elts)) + (cons "vars" (caddr elts))))) (define (classify-module-object name var elts) (let ((obj (and (variable-bound? var) (variable-ref var)))) (cond ((or (not obj) (module? obj)) elts) ((or (procedure? obj) (program? obj)) - (list (cons (list name `(signature . ,(obj-signature name obj))) + (list (cons (list name `("signature" . ,(obj-signature name obj))) (car elts)) (cadr elts) (caddr elts))) ((macro? obj) (list (car elts) - (cons (list name `(signature . ,(obj-signature name obj))) + (cons (list name `("signature" . ,(obj-signature name obj))) (cadr elts)) (caddr elts))) (else (list (car elts) diff --git a/scheme/guile/geiser/utils.scm b/scheme/guile/geiser/utils.scm index 632fe76..654cae8 100644 --- a/scheme/guile/geiser/utils.scm +++ b/scheme/guile/geiser/utils.scm @@ -30,8 +30,8 @@ (else (loop (cdr d) (cons (car d) s)))))) (define (make-location file line) - (list (cons 'file (if (string? file) file '())) - (cons 'line (if (number? line) (+ 1 line) '())))) + (list (cons "file" (if (string? file) file '())) + (cons "line" (if (number? line) (+ 1 line) '())))) (define (sort-symbols! syms) (let ((cmp (lambda (l r) diff --git a/scheme/guile/geiser/xref.scm b/scheme/guile/geiser/xref.scm index 7dfa8af..ba509e7 100644 --- a/scheme/guile/geiser/xref.scm +++ b/scheme/guile/geiser/xref.scm @@ -40,9 +40,9 @@ (define (make-xref proc name module) (and proc - `((location . ,(or (program-location proc) (symbol-location name))) - (signature . ,(object-signature name proc)) - (module . ,(or module '()))))) + `(("location" . ,(or (program-location proc) (symbol-location name))) + ("signature" . ,(object-signature name proc)) + ("module" . ,(or module '()))))) (define (program-location p) (cond ((not (program? p)) #f) @@ -82,5 +82,3 @@ (if (null? dirs) #f (let ((candidate (string-append (car dirs) "/" path))) (if (file-exists? candidate) candidate (loop (cdr dirs))))))) - -;;; xref.scm ends here diff --git a/scheme/racket/geiser/autodoc.rkt b/scheme/racket/geiser/autodoc.rkt index dea8f43..6e73271 100644 --- a/scheme/racket/geiser/autodoc.rkt +++ b/scheme/racket/geiser/autodoc.rkt @@ -40,11 +40,11 @@ (let* ([val (value sym (symbol-module sym))] [sign (autodoc* sym)]) (and sign - (list (cons 'signature (autodoc* sym #f)) - (cons 'docstring (docstring sym val sign)))))) + (list (cons "signature" (autodoc* sym #f)) + (cons "docstring" (docstring sym val sign)))))) (define (docstring sym val sign) - (let* ([mod (assoc 'module (cdr sign))] + (let* ([mod (assoc "module" (cdr sign))] [mod (if mod (cdr mod) "")] [id (namespace-symbol->identifier sym)] [desc (if (identifier? id) (format "~%~%~a" (describe id sym)) "")]) @@ -118,26 +118,26 @@ [path (cdr loc)] [sgns (and path (find-signatures path name id))] [value (if (and extra sgns (not (list? sgns))) - (list (cons 'value (val))) + (list (cons "value" (val))) '())] [mod (if (and extra sgns path) - (list (cons 'module + (list (cons "module" (module-path-name->name path))) '())]) (and sgns `(,id - (name . ,name) - (args ,@(if (list? sgns) (map format-signature sgns) '())) + ("name" . ,name) + ("args" ,@(if (list? sgns) (map format-signature sgns) '())) ,@value ,@mod))))) (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))) + `(("required" ,@(signature-required sign)) + ("optional" ,@(signature-optional sign) + ,@(let ((rest (signature-rest sign))) + (if rest (list "...") '()))) + ("key" ,@(signature-keys sign))) '())) (define signatures (make-hash)) @@ -281,21 +281,21 @@ (define (contracted id) (let ([v (value id mod)]) (if (has-contract? v) - (list id (cons 'info (contract-name (value-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)))) + (if sign (list id (cons "signature" sign)) (list id)))) (define (classify-ids ids) (let loop ([ids ids] [procs '()] [vars '()]) (cond [(null? ids) - `((procs ,@(map entry (reverse procs))) - (vars ,@(map list (reverse vars))))] + `(("procs" ,@(map entry (reverse procs))) + ("vars" ,@(map list (reverse vars))))] [(procedure? (value (car ids) mod)) (loop (cdr ids) (cons (car ids) procs) vars)] [else (loop (cdr ids) procs (cons (car ids) vars))]))) (let-values ([(ids syn) (module-identifiers mod)]) `(,@(classify-ids ids) - (syntax ,@(map contracted syn)) - (modules ,@(map list (or (submodules mod) '())))))) + ("syntax" ,@(map contracted syn)) + ("modules" ,@(map list (or (submodules mod) '())))))) diff --git a/scheme/racket/geiser/locations.rkt b/scheme/racket/geiser/locations.rkt index 4715b8f..1ed4534 100644 --- a/scheme/racket/geiser/locations.rkt +++ b/scheme/racket/geiser/locations.rkt @@ -30,9 +30,9 @@ (cons sym #f)))) (define (make-location name path line) - (list (cons 'name name) - (cons 'file (if (path? path) (path->string path) '())) - (cons 'line (or line '())))) + (list (cons "name" name) + (cons "file" (if (path? path) (path->string path) '())) + (cons "line" (or line '())))) (define (symbol-location sym) (let* ([loc (symbol-location* sym)] -- cgit v1.2.3