Use restarts for control flow (#171)

Restarts are a (very) rarely used technique that allows for non-local control flow, i.e. the ability to jump immediately to a different destination in a calling function. This allows us to direct what should happen in the error calling handler (which usually can't affect control flow) based on the value of `on_error`.
r-lib · Jun 25, 2024 · 000306c · 000306c
1 parent 67efbbd
commit 000306c
Show file tree

Hide file tree

Showing 2 changed files with 38 additions and 48 deletions.
diff --git a/R/eval.R b/R/eval.R
@@ -89,20 +89,28 @@ evaluate <- function(input,
     if (log_echo || debug) {
       cat_line(parsed$src[[i]], file = stderr())
     }
-    evaluate_top_level_expression(
-      exprs = parsed$expr[[i]],
-      src = parsed$src[[i]],
-      watcher = watcher,
-      envir = envir,
-      use_try = on_error != "error",
-      keep_warning = keep_warning,
-      keep_message = keep_message,
-      log_warning = log_warning,
-      output_handler = output_handler
+    continue <- withRestarts(
+      {
+        evaluate_top_level_expression(
+          exprs = parsed$expr[[i]],
+          src = parsed$src[[i]],
+          watcher = watcher,
+          envir = envir,
+          on_error = on_error,
+          keep_warning = keep_warning,
+          keep_message = keep_message,
+          log_warning = log_warning,
+          output_handler = output_handler
+        )
+        TRUE
+      },
+      eval_continue = function() TRUE,
+      eval_stop = function() FALSE,
+      eval_error = function(cnd) stop(cnd)
     )
     watcher$check_devices()
 
-    if (on_error == "stop" && watcher$has_errored()) {
+    if (!continue) {
       break
     }
   }
@@ -117,7 +125,7 @@ evaluate_top_level_expression <- function(exprs,
                                           src,
                                           watcher,
                                           envir = parent.frame(),
-                                          use_try = FALSE,
+                                          on_error = "continue",
                                           keep_warning = TRUE,
                                           keep_message = TRUE,
                                           log_warning = FALSE,
@@ -169,22 +177,15 @@ evaluate_top_level_expression <- function(exprs,
   }
   eHandler <- function(cnd) {
     handle_output()
-    if (use_try) {
-      cnd <- reset_call(cnd)
-      watcher$errored()
-      watcher$push(cnd)
-      output_handler$error(cnd)
-    }
-  }
-
-  if (use_try) {
-    handle <- function(code) {
-      tryCatch(code, error = function(err) {
-        list(value = NULL, visible = FALSE)
-      })
-    }
-  } else {
-    handle <- force
+
+    cnd <- reset_call(cnd)
+    watcher$push(cnd)
+
+    switch(on_error,
+      continue = invokeRestart("eval_continue"),
+      stop = invokeRestart("eval_stop"),
+      error = invokeRestart("eval_error", cnd)
+    )
   }
 
   user_handlers <- output_handler$calling_handlers
@@ -193,11 +194,9 @@ evaluate_top_level_expression <- function(exprs,
   handlers <- c(user_handlers, evaluate_handlers)
 
   for (expr in exprs) {
-    ev <- handle(
-      with_handlers(
-        withVisible(eval(expr, envir)),
-        handlers
-      )
+    ev <- with_handlers(
+      withVisible(eval(expr, envir)),
+      handlers
     )
     handle_output(TRUE)
 
@@ -206,13 +205,11 @@ evaluate_top_level_expression <- function(exprs,
       # any methods registered in that environment. That, however, is 
       # challenging and only makes a few tests a little simpler so we don't
       # bother.
-      pv <- handle(
-        with_handlers(
-          withVisible(
-            handle_value(output_handler, ev$value, ev$visible)
-          ),
-          handlers
-        )
+      pv <- with_handlers(
+        withVisible(
+          handle_value(output_handler, ev$value, ev$visible)
+        ),
+        handlers
       )
       handle_output(TRUE)
       # If the return value is visible, save the value to the output

diff --git a/R/watcher.R b/R/watcher.R
@@ -20,11 +20,6 @@ watchout <- function(handler = new_output_handler(),
     invisible()
   }
 
-  # record whether or not we've seen an error
-  has_error <- FALSE
-  errored <- function() has_error <<- TRUE
-  has_errored <- function() has_error
-
   # record current devices for plot handling
   last_plot <- NULL
   devn <- length(dev.list())
@@ -94,9 +89,7 @@ watchout <- function(handler = new_output_handler(),
     capture_output = capture_output,
     check_devices = check_devices,
     push = push,
-    get = function() new_evaluation(output),
-    errored = errored,
-    has_errored = has_errored
+    get = function() new_evaluation(output)
   )
 }