Elisp: more flexible parsing of :eval and :ge forms

This allows the implementation decide the concrete structure of the
code sent to the REPL. For instance, it doesn't need to be a single
s-expression, and argument order can be re-arranged.

9 files changed, 36 insertions, 32 deletions

diff --git a/elisp/geiser-autodoc.el b/elisp/geiser-autodoc.el
index bf57187..35a9834 100644
--- a/elisp/geiser-autodoc.el
+++ b/elisp/geiser-autodoc.el
@@ -70,7 +70,7 @@ when `geiser-autodoc-display-module-p' is on."
                   (push f missing)))))
           (unless (or cached keep-cached) (geiser-autodoc--clean-cache))
           (when missing
-            (let ((res (geiser-eval--send/result `(:eval ((:ge autodoc)
+            (let ((res (geiser-eval--send/result `(:eval (:ge autodoc
                                                           (quote ,missing)))
                                                  500)))
               (when res
diff --git a/elisp/geiser-compile.el b/elisp/geiser-compile.el
index 41ca4bd..bc9aace 100644
--- a/elisp/geiser-compile.el
+++ b/elisp/geiser-compile.el
@@ -29,7 +29,7 @@
 
 (defun geiser-compile--display-result (title ret)
   (if (not (geiser-eval--retort-error ret))
-      (message "%s %s" title (or (geiser-eval--retort-result ret) "done."))
+      (message "%s done" title)
     (message ""))
   (geiser-debug--display-retort title ret))
 
diff --git a/elisp/geiser-completion.el b/elisp/geiser-completion.el
index 63a1e07..5c2f604 100644
--- a/elisp/geiser-completion.el
+++ b/elisp/geiser-completion.el
@@ -153,10 +153,10 @@ terminates a current completion."
 (defun geiser-completion--symbol-list (prefix)
   (geiser--del-dups
    (append (all-completions prefix (geiser-completion--locals))
-           (geiser-eval--send/result `(:eval ((:ge completions) ,prefix))))))
+           (geiser-eval--send/result `(:eval (:ge completions ,prefix))))))
 
 (defsubst geiser-completion--module-list (prefix)
-  (geiser-eval--send/result `(:eval ((:ge module-completions) ,prefix))))
+  (geiser-eval--send/result `(:eval (:ge module-completions ,prefix))))
 
 (defvar geiser-completion--symbol-list-func
   (completion-table-dynamic 'geiser-completion--symbol-list))
diff --git a/elisp/geiser-debug.el b/elisp/geiser-debug.el
index 42f1dec..9266eb3 100644
--- a/elisp/geiser-debug.el
+++ b/elisp/geiser-debug.el
@@ -120,8 +120,8 @@ buffer.")
 (defun geiser-debug--expand-region (start end all wrap)
   (let* ((str (buffer-substring-no-properties start end))
          (wrapped (if wrap (geiser-debug--wrap-region str) str))
-         (code `(:eval ((:ge macroexpand) (quote (:scm ,wrapped))
-                        ,(if all :t :f))))
+         (code `(:eval (:ge macroexpand (quote (:scm ,wrapped))
+                            ,(if all :t :f))))
          (ret (geiser-eval--send/wait code))
          (err (geiser-eval--retort-error ret))
          (result (geiser-eval--retort-result ret)))
diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el
index e8e3f58..3096a3d 100644
--- a/elisp/geiser-doc.el
+++ b/elisp/geiser-doc.el
@@ -221,11 +221,11 @@ help (e.g. browse an HTML page) implementing this method.")
 
 (defun geiser-doc--get-docstring (symbol module)
   (geiser-eval--send/result
-   `(:eval ((:ge symbol-documentation) ',symbol) ,module)))
+   `(:eval (:ge symbol-documentation ',symbol) ,module)))
 
 (defun geiser-doc--get-module-exports (module)
   (geiser-eval--send/result
-   `(:eval ((:ge module-exports) (:module ,module)))))
+   `(:eval (:ge module-exports (:module ,module)))))
 
 (defun geiser-doc-symbol (symbol &optional module impl)
   (let ((module (or module (geiser-eval--get-module)))
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el
index 409e783..cebcb47 100644
--- a/elisp/geiser-edit.el
+++ b/elisp/geiser-edit.el
@@ -193,7 +193,7 @@ or following links in error buffers.")
    (list (geiser-completion--read-symbol "Edit symbol: "
                                          nil
                                          geiser-edit--symbol-history)))
-  (let ((cmd `(:eval ((:ge symbol-location) ',symbol))))
+  (let ((cmd `(:eval (:ge symbol-location ',symbol))))
     (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method)
     (when marker (ring-insert find-tag-marker-ring marker))))
 
@@ -203,7 +203,7 @@ With prefix, asks for the symbol to edit."
   (interactive "P")
   (let* ((symbol (or (and (not arg) (symbol-at-point))
                      (geiser-completion--read-symbol "Edit symbol: ")))
-         (cmd `(:eval ((:ge symbol-location) ',symbol)))
+         (cmd `(:eval (:ge symbol-location ',symbol)))
          (marker (point-marker)))
     (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd))
     (when marker (ring-insert find-tag-marker-ring marker))))
@@ -218,7 +218,7 @@ With prefix, asks for the symbol to edit."
 (defun geiser-edit-module (module &optional method)
   "Asks for a module and opens it in a new buffer."
   (interactive (list (geiser-completion--read-module)))
-  (let ((cmd `(:eval ((:ge module-location) (:module ,module)))))
+  (let ((cmd `(:eval (:ge module-location (:module ,module)))))
     (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method)))
 
 
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
index fd769db..df31594 100644
--- a/elisp/geiser-eval.el
+++ b/elisp/geiser-eval.el
@@ -53,42 +53,46 @@ symbol-location, module-location, symbol-documentation,
 module-exports, autodoc, callers, callees and generic-methods.")
 
 (defun geiser-eval--supported-p (feat)
-  (not (memq feat geiser-eval--unsupported)))
+  (or (not geiser-eval--unsupported)
+      (not (memq feat geiser-eval--unsupported))))
 
-(defsubst geiser-eval--form (proc)
-  (when (and geiser-eval--unsupported (memq proc geiser-eval--unsupported))
+(defsubst geiser-eval--form (&rest args)
+  (when (not (geiser-eval--supported-p (car args)))
     (error "Sorry, the %s scheme implementation does not support Geiser's %s"
-           geiser-impl--implementation proc))
-  (funcall geiser-eval--geiser-procedure-function proc))
+           geiser-impl--implementation (car args)))
+  (apply geiser-eval--geiser-procedure-function args))
 
 
 ;;; Code formatting:
 
 (defsubst geiser-eval--eval (code)
-  (geiser-eval--scheme-str
-   `(,(geiser-eval--form 'eval) (quote ,(nth 0 code))
-     (:module ,(nth 1 code)))))
+  (geiser-eval--form 'eval
+                     (geiser-eval--module (nth 1 code))
+                     (geiser-eval--scheme-str (nth 0 code))))
 
 (defsubst geiser-eval--comp (code)
-  (geiser-eval--scheme-str
-   `(,(geiser-eval--form 'compile)
-     (quote ,(nth 0 code)) (:module ,(nth 1 code)))))
+  (geiser-eval--form 'compile
+                     (geiser-eval--module (nth 1 code))
+                     (geiser-eval--scheme-str (nth 0 code))))
 
 (defsubst geiser-eval--load-file (file)
-  (geiser-eval--scheme-str `(,(geiser-eval--form 'load-file) ,file)))
+  (geiser-eval--form 'load-file
+                     (geiser-eval--scheme-str file)))
 
 (defsubst geiser-eval--comp-file (file)
-  (geiser-eval--scheme-str `(,(geiser-eval--form 'compile-file) ,file)))
+  (geiser-eval--form 'compile-file
+                     (geiser-eval--scheme-str file)))
 
 (defsubst geiser-eval--module (code)
   (geiser-eval--scheme-str
    (cond ((or (null code) (eq code :t) (eq code :buffer))
-          (list 'quote (funcall geiser-eval--get-module-function)))
+          (funcall geiser-eval--get-module-function))
          ((or (eq code :repl) (eq code :f)) :f)
-         (t (list 'quote (funcall geiser-eval--get-module-function code))))))
+         (t (funcall geiser-eval--get-module-function code)))))
 
-(defsubst geiser-eval--ge (proc)
-  (geiser-eval--scheme-str (geiser-eval--form proc)))
+(defsubst geiser-eval--ge (proc args)
+  (apply 'geiser-eval--form (cons proc
+                                  (mapcar 'geiser-eval--scheme-str args))))
 
 (defun geiser-eval--scheme-str (code)
   (cond ((null code) "'()")
@@ -102,7 +106,8 @@ module-exports, autodoc, callers, callees and generic-methods.")
                ((eq (car code) :comp-file)
                 (geiser-eval--comp-file (cadr code)))
                ((eq (car code) :module) (geiser-eval--module (cadr code)))
-               ((eq (car code) :ge) (geiser-eval--ge (cadr code)))
+               ((eq (car code) :ge) (geiser-eval--ge (cadr code)
+                                                     (cddr code)))
                ((eq (car code) :scm) (cadr code))
                (t (concat "("
                           (mapconcat 'geiser-eval--scheme-str code " ")
diff --git a/elisp/geiser-repl.el b/elisp/geiser-repl.el
index d55207e..900ba16 100644
--- a/elisp/geiser-repl.el
+++ b/elisp/geiser-repl.el
@@ -481,8 +481,7 @@ With a prefix argument, force exit by killing the scheme process."
         (compilation-forget-errors))
       (comint-send-input)
       (when (string-match "^\\s-*$" intxt)
-        (comint-send-string proc
-                            (geiser-eval--scheme-str '((:ge no-values))))
+        (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values)))
         (comint-send-string proc "\n")))))
 
 (defun geiser-repl--maybe-send ()
diff --git a/elisp/geiser-xref.el b/elisp/geiser-xref.el
index 29bc008..a93b7a8 100644
--- a/elisp/geiser-xref.el
+++ b/elisp/geiser-xref.el
@@ -111,7 +111,7 @@
 (defun geiser-xref--fetch-xrefs (ask kind rkind proc)
   (let* ((name (geiser-xref--read-name ask (format "%s: " (capitalize kind))))
          (res (and name (geiser-eval--send/result
-                         `(:eval ((:ge ,proc) (quote (:scm ,name))))))))
+                         `(:eval (:ge ,proc (quote (:scm ,name))))))))
     (message "Retrieving %ss list for '%s'..." rkind name)
     (if (or (not res) (not (listp res)))
         (message "No %ss found for '%s'" rkind name)