Christophe Weblog Wiki Code Publications Music
implement a mini code-walker to support nested function calls in :emacs-rex
authorChristophe Rhodes <csr21@cantab.net>
Mon, 30 Aug 2010 20:42:59 +0000 (21:42 +0100)
committerChristophe Rhodes <csr21@cantab.net>
Mon, 30 Aug 2010 20:42:59 +0000 (21:42 +0100)
This is all a bit horrible, but probably limited in maintenance headaches.

swank.R

diff --git a/swank.R b/swank.R
index 578d61c75a83f45f2a82081d9a09d89dc10d243e..b9d89cbc6959c37b59a0e2c16ec7d064ee677a7b 100644 (file)
--- a/swank.R
+++ b/swank.R
@@ -59,12 +59,32 @@ sendToEmacs <- function(slimeConnection, obj) {
   cat(sprintf("%06x", nchar(payload)), payload, sep="")
 }
 
   cat(sprintf("%06x", nchar(payload)), payload, sep="")
 }
 
+callify <- function(form) {
+  ## we implement here the conversion from Lisp S-expression (or list)
+  ## expressions of code into our own, swankr, calling convention,
+  ## with slimeConnection and sldbState as first and second arguments.
+  ## as.call() gets us part of the way, but we need to walk the list
+  ## recursively to mimic CL:EVAL; we need to avoid converting R
+  ## special operators which we are punning (only `quote`, for now)
+  ## into this calling convention.
+  if(is.list(form)) {
+    if(form[[1]] == quote(quote)) {
+      as.call(form)
+    } else {
+      as.call(c(list(form[[1]], quote(slimeConnection), quote(sldbState)), lapply(form[-1], callify)))
+    }
+  } else {
+    form
+  }
+}
+
 emacsRex <- function(slimeConnection, sldbState, form, pkg, thread, id, level=0) {
   ok <- FALSE
   value <- NULL
   tryCatch({
     withCallingHandlers({
 emacsRex <- function(slimeConnection, sldbState, form, pkg, thread, id, level=0) {
   ok <- FALSE
   value <- NULL
   tryCatch({
     withCallingHandlers({
-      value <- do.call(eval(form[[1]]), c(list(slimeConnection), list(sldbState), form[-1]))
+      call <- callify(form)
+      value <- eval(call)
       ok <- TRUE
     }, error=function(c) {
       newSldbState <- makeSldbState(c, if(is.null(sldbState)) 0 else sldbState$level+1, id)
       ok <- TRUE
     }, error=function(c) {
       newSldbState <- makeSldbState(c, if(is.null(sldbState)) 0 else sldbState$level+1, id)