initial implementation of support for REPL presentations

There's a lot here that's ugly, unfinished or just downright horrible.
Most notably, presentation support depends on swank-side read-time
evaluation (indicated with Common Lisp syntax, which hilariously is a
comment in R).  We can't support that in general, but we can
special-case the presentation-specific operator.

But then the next difficulty comes along; actually performing that
read-time evaluation needs to happen in a different environment than
the evaluation of the REPL form.  In order to achieve this, we abuse
bquote() the equivalent of Lisp's backquote facility, by calling what
in CL terms would be its macro-function on the parsed, preprocessed
expression; only after doing that (and hence resolving the `read-time'
evaluations) do we evaluate the call itself.

The implementation of presentation protocol messages is also slightly
ugly; having to implement cl:nth-value is particulraly horrible, but
the lack of weak references / weak tables in R (at least as far as I
can tell at the moment) is a cause of niggling concern.

diff --git a/swank-presentations.R b/swank-presentations.R
new file mode 100644 (file)
index 0000000..d2ed3f7
--- /dev/null
+++ b/swank-presentations.R
@@ -0,0 +1,47 @@
+presentationCounter <- 0
+
+savePresentedObject <- function(slimeConnection, value) {
+  if(!exists("idToObject", envir=slimeConnection)) {
+    assign("idToObject", new.env(), envir=slimeConnection)
+  }
+  presentationCounter <<- presentationCounter + 1
+  assign(as.character(presentationCounter), value, envir=slimeConnection$idToObject)
+  presentationCounter
+}
+
+presentReplResult <- function(slimeConnection, value) {
+  id <- savePresentedObject(slimeConnection, value)
+  sendToEmacs(slimeConnection,
+              list(quote(`:presentation-start`), id, quote(`:repl-result`)))
+  sendReplResult(slimeConnection, value)
+  sendToEmacs(slimeConnection,
+              list(quote(`:presentation-end`), id, quote(`:repl-result`)))
+  sendToEmacs(slimeConnection,
+              list(quote(`:write-string`), "\n", quote(`:repl-result`)))
+}
+
+sendReplResultFunction <- presentReplResult
+
+`cl:nth-value` <- function(slimeConnection, sldbState, n, values) {
+  values[[n+1]]
+}
+
+`swank:lookup-presented-object` <- function(slimeConnection, sldbState, id) {
+  str(ls(slimeConnection))
+  if(exists(as.character(id), envir=slimeConnection$idToObject)) {
+    value <- get(as.character(id), envir=slimeConnection$idToObject)
+    list(value, TRUE)
+  } else {
+    list(FALSE, FALSE)
+  }
+}
+
+`swank:lookup-presented-object-or-lose` <- function(slimeConnection, sldbState, id) {
+  stuff <- `swank:lookup-presented-object`(slimeConnection, sldbState, id)
+  if(stuff[[2]]) {
+    stuff[[1]]
+  } else {
+    stop(sprintf("attempt to access unrecorded object (id %d)", id))
+  }
+}
+    

diff --git a/swank.R b/swank.R
index e6e78c7e15996168ad9db03c1ab154c3d2dd9b9e..bd7e093703fa4a4d5f9fc5ea7e1ad986853ad7fa 100644 (file)
--- a/swank.R
+++ b/swank.R
@@ -272,10 +272,22 @@ printToString <- function(val) {
   list("R", "R")
 }
 
+sendReplResult <- function(slimeConnection, value) {
+  string <- printToString(value)
+  sendToEmacs(slimeConnection,
+              list(quote(`:write-string`),
+                   paste(string, collapse="\n"),
+                   quote(`:repl-result`)))
+}
+
+sendReplResultFunction <- sendReplResult
+
 `swank:listener-eval` <- function(slimeConnection, sldbState, string) {
-  val <- eval(parse(text=string), envir = globalenv())
-  string <- printToString(val)
-  sendToEmacs(slimeConnection, list(quote(`:write-string`), paste(string, collapse="\n"), quote(`:repl-result`)))
+  string <- gsub("#\\.\\(swank:lookup-presented-object-or-lose([^)]*)\\)", ".(`swank:lookup-presented-object-or-lose`(slimeConnection, sldbState,\\1))", string)
+  expr <- parse(text=string)[[1]]
+  lookedup <- do.call("bquote", list(expr))
+  value <- eval(lookedup, envir = globalenv())
+  sendReplResultFunction(slimeConnection, value)
   list()
 }