summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-27 00:54:59 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2010-11-27 00:54:59 +0100
commitb39fd77d8899bc7ff6608645afc9e2eb0eb0d33c (patch)
tree2228ff22afcc5423239572bbcdf186d31e11714a
parent96610db57a61d5380eeeb3b4780846c39fb79422 (diff)
downloadgeiser-guile-b39fd77d8899bc7ff6608645afc9e2eb0eb0d33c.tar.gz
geiser-guile-b39fd77d8899bc7ff6608645afc9e2eb0eb0d33c.tar.bz2
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.
-rw-r--r--elisp/geiser-autodoc.el14
-rw-r--r--elisp/geiser-doc.el16
-rw-r--r--elisp/geiser-edit.el10
-rw-r--r--elisp/geiser-syntax.el9
-rw-r--r--elisp/geiser-xref.el16
-rw-r--r--scheme/guile/geiser/doc.scm29
-rw-r--r--scheme/guile/geiser/utils.scm4
-rw-r--r--scheme/guile/geiser/xref.scm8
-rw-r--r--scheme/racket/geiser/autodoc.rkt36
-rw-r--r--scheme/racket/geiser/locations.rkt6
10 files changed, 75 insertions, 73 deletions
diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index 7c61b33..8222e0b 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -59,7 +59,7 @@ when `geiser-autodoc-display-module-p' is on."
(defun geiser-autodoc--get-signatures (funs &optional keep-cached)
(when funs
- (let ((fs (assq (car funs) geiser-autodoc--cached-signatures)))
+ (let ((fs (assoc (car funs) geiser-autodoc--cached-signatures)))
(unless fs
(let ((missing) (cached))
(if (not geiser-autodoc--cached-signatures)
@@ -127,11 +127,11 @@ when `geiser-autodoc-display-module-p' is on."
(defun geiser-autodoc--insert-args (args pos prev)
(let ((cpos 1)
- (reqs (cdr (assoc 'required args)))
+ (reqs (cdr (assoc "required" args)))
(opts (mapcar (lambda (a)
(if (and (symbolp a) (not (eq a '...))) (list a) a))
- (cdr (assoc 'optional args))))
- (keys (cdr (assoc 'key args))))
+ (cdr (assoc "optional" args))))
+ (keys (cdr (assoc "key" args))))
(setq cpos
(geiser-autodoc--insert-arg-group reqs
cpos
@@ -155,10 +155,10 @@ when `geiser-autodoc-display-module-p' is on."
(defun geiser-autodoc--str (desc signature)
(let ((proc (car desc))
- (args (cdr (assoc 'args signature)))
- (module (cdr (assoc 'module signature))))
+ (args (cdr (assoc "args" signature)))
+ (module (cdr (assoc "module" signature))))
(if (not args)
- (geiser-autodoc--value-str proc module (cdr (assoc 'value signature)))
+ (geiser-autodoc--value-str proc module (cdr (assoc "value" signature)))
(save-current-buffer
(set-buffer (geiser-syntax--font-lock-buffer))
(erase-buffer)
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index e975484..9182bab 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -236,8 +236,8 @@ help (e.g. browse an HTML page) implementing this method.")
(newline)
(dolist (w lst)
(let ((name (car w))
- (signature (cdr (assoc 'signature w)))
- (info (cdr (assoc 'info w))))
+ (signature (cdr (assoc "signature" w)))
+ (info (cdr (assoc "info" w))))
(insert "\t- ")
(if module
(geiser-doc--insert-button name module impl signature)
@@ -294,9 +294,9 @@ help (e.g. browse an HTML page) implementing this method.")
(geiser-doc--with-buffer
(erase-buffer)
(geiser-doc--insert-title
- (geiser-autodoc--str* (cdr (assoc 'signature ds))))
+ (geiser-autodoc--str* (cdr (assoc "signature" ds))))
(newline)
- (insert (or (cdr (assoc 'docstring ds)) ""))
+ (insert (or (cdr (assoc "docstring" ds)) ""))
(geiser-doc--buttonize-modules impl)
(setq geiser-doc--buffer-link
(geiser-doc--history-push (geiser-doc--make-link symbol
@@ -327,10 +327,10 @@ With prefix argument, ask for the lookup symbol (with completion)."
symbol
(geiser-eval--get-module))))
-(defconst geiser-doc--sections '(("Procedures:" procs)
- ("Syntax:" syntax)
- ("Variables:" vars)
- ("Submodules:" modules t)))
+(defconst geiser-doc--sections '(("Procedures:" "procs")
+ ("Syntax:" "syntax")
+ ("Variables:" "vars")
+ ("Submodules:" "modules" t)))
(defconst geiser-doc--sections-re
(format "^%s\n" (regexp-opt (mapcar 'car geiser-doc--sections))))
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index 8fa979f..0fd3b89 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -47,23 +47,23 @@ or following links in error buffers.")
(t (find-file file))))
(defsubst geiser-edit--location-name (loc)
- (cdr (assoc 'name loc)))
+ (cdr (assoc "name" loc)))
(defsubst geiser-edit--location-file (loc)
- (cdr (assoc 'file loc)))
+ (cdr (assoc "file" loc)))
(defsubst geiser-edit--to-number (x)
(cond ((numberp x) x)
((stringp x) (string-to-number x))))
(defsubst geiser-edit--location-line (loc)
- (geiser-edit--to-number (cdr (assoc 'line loc))))
+ (geiser-edit--to-number (cdr (assoc "line" loc))))
(defsubst geiser-edit--location-column (loc)
- (geiser-edit--to-number (cdr (assoc 'column loc))))
+ (geiser-edit--to-number (cdr (assoc "column" loc))))
(defsubst geiser-edit--make-location (name file line column)
- `((name . ,name) (file . ,file) (line . ,line) (column . ,column)))
+ `(("name" . ,name) ("file" . ,file) ("line" . ,line) ("column" . ,column)))
(defconst geiser-edit--def-re
(regexp-opt '("define"
diff --git a/elisp/geiser-syntax.el b/elisp/geiser-syntax.el
index ae1c3dd..17e0999 100644
--- a/elisp/geiser-syntax.el
+++ b/elisp/geiser-syntax.el
@@ -122,6 +122,11 @@ implementation-specific entries for font-lock-keywords.")
(defsubst geiser-syntax--read/elisp ()
(ignore-errors (read (current-buffer))))
+(defun geiser-syntax--read/symbol ()
+ (with-syntax-table scheme-mode-syntax-table
+ (when (re-search-forward "\\(\\sw\\|\\s_\\)+" nil t)
+ (make-symbol (match-string 0)))))
+
(defun geiser-syntax--read/matching (open close)
(let ((count 1)
(p (1+ (point))))
@@ -160,7 +165,7 @@ implementation-specific entries for font-lock-keywords.")
(?\( (geiser-syntax--read/token 'vectorb))
(?\< (geiser-syntax--read/unprintable))
((?' ?` ?,) (geiser-syntax--read/next-token))
- (t (let ((tok (geiser-syntax--read/elisp)))
+ (t (let ((tok (geiser-syntax--read/symbol)))
(if tok (cons 'atom (intern (format "#%s" tok)))
(geiser-syntax--read/next-token))))))
(?\' (geiser-syntax--read/token '(quote . quote)))
@@ -171,7 +176,7 @@ implementation-specific entries for font-lock-keywords.")
`(splice . ,backquote-splice-symbol))
`(unquote . ,backquote-unquote-symbol)))
(?\" (cons 'string (geiser-syntax--read/elisp)))
- (t (cons 'atom (geiser-syntax--read/elisp))))))
+ (t (cons 'atom (geiser-syntax--read/symbol))))))
(defsubst geiser-syntax--read/match (&rest tks)
(let ((token (geiser-syntax--read/next-token)))
diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
index 661c625..d8b46d0 100644
--- a/elisp/geiser-xref.el
+++ b/elisp/geiser-xref.el
@@ -54,12 +54,12 @@
geiser-xref-follow-link-method))))
(defun geiser-xref--insert-button (xref)
- (let* ((location (cdr (assoc 'location xref)))
+ (let* ((location (cdr (assoc "location" xref)))
(file (geiser-edit--location-file location))
- (signature (cdr (assoc 'signature xref)))
+ (signature (cdr (assoc "signature" xref)))
(signature-txt (and signature
(geiser-autodoc--str* signature)))
- (module (cdr (assoc 'module xref)))
+ (module (cdr (assoc "module" xref)))
(p (point)))
(when signature
(insert " - ")
@@ -76,11 +76,11 @@
(newline))))
(defun geiser-xref--module< (xr1 xr2)
- (let ((m1 (cdr (assoc 'module xr1)))
- (m2 (cdr (assoc 'module xr2))))
+ (let ((m1 (cdr (assoc "module" xr1)))
+ (m2 (cdr (assoc "module" xr2))))
(cond ((equal m1 m2)
- (string< (format "%s" (cdr (assoc 'signature xr1)))
- (format "%s" (cdr (assoc 'signature xr2)))))
+ (string< (format "%s" (cdr (assoc "signature" xr1)))
+ (format "%s" (cdr (assoc "signature" xr2)))))
((null m1) (not m2))
((null m2))
(t (string< (format "%s" m1) (format "%s" m2))))))
@@ -92,7 +92,7 @@
(newline)
(let ((last-module))
(dolist (xref (sort xrefs 'geiser-xref--module<))
- (let ((module (cdr (assoc 'module xref))))
+ (let ((module (cdr (assoc "module" xref))))
(when (not (equal module last-module))
(insert "\n In module ")
(geiser--insert-with-face (format "%s" module)
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) "<unknown>")]
[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)]