More debug improvements; hook onto the debug stack in the future package

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.mirai
-Version: 0.2.2-9223
+Version: 0.2.2-9224
 Depends:
     future (>= 1.40.0)
 Imports:

R/001.import_future_functions.R

@@ -10,6 +10,7 @@ getFutureData <- NULL
 getFutureBackendConfigs <- NULL
 cancel <- NULL
 sQuoteLabel <- NULL
+.debug <- NULL
 
 ## Import private functions from 'future'
 import_future_functions <- function() {
@@ -45,4 +46,6 @@ import_future_functions <- function() {
         sQuote(label)
     }
   })
+
+  .debug <<- import_future(".debug", mode = "environment", default = new.env(parent = emptyenv()))
 }

R/utils-debug.R

@@ -4,47 +4,28 @@ now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
 }
 
 debug_indent <- local({
-  prefix <- ""
-  depth <- 0L
   symbols <- rep(c("|", ":", ".", "'", ",", ";", "`"), times = 10L)
-
-  function(delta = 0L) {
-    if (delta == 0) return(prefix)
-    if (delta > 0) {
-      depth <<- depth + 1L
-    } else if (delta < 0) {
-      depth <<- depth - 1L
-      if (depth < 0L) {
-        calls <- paste(vapply(sys.calls(), FUN = deparse, FUN.VALUE = NA_character_), collapse = " -> ")
-        warning(sprintf("[INTERNAL WARNING]: There appears to be one mdebug_pop() too many: %s", calls), call. = TRUE, immediate. = TRUE)
-        depth <- 0L
-      }
-    }
-    prefix <<- if (depth == 0) {
-      ""
-    } else {
-      
-      indent <- getOption("future.debug.indent", " ")
-      paste(paste(symbols[seq_len(depth)], indent, sep = ""), collapse = "")
-    }
+  function() {
+    depth <- length(.debug[["stack"]])
+    if (depth == 0) return("")
+    indent <- getOption("future.debug.indent", " ")
+    paste(paste(symbols[seq_len(depth)], indent, sep = ""), collapse = "")
   }
 })
 
-.debug <- new.env(parent = emptyenv())
-.debug$stack <- list()
+if (!exists(".debug", inherits = FALSE)) .debug <- new.env(parent = emptyenv())
+if (!"stack" %in% names(".debug")) .debug$stack <- list()
 
 mdebug_push <- function(..., debug = isTRUE(getOption("future.debug"))) {
   if (!debug) return()
   msg <- mdebug(..., debug = debug)
-  debug_indent(+1)
   .debug$stack <- c(.debug$stack, msg)
   invisible(msg)
 }
 
 mdebugf_push <- function(..., debug = isTRUE(getOption("future.debug"))) {
   if (!debug) return()
   msg <- mdebugf(..., debug = debug)
-  debug_indent(+1)
   .debug$stack <- c(.debug$stack, msg)
   invisible(msg)
 }
@@ -54,7 +35,6 @@ mdebug_pop <- function(..., debug = isTRUE(getOption("future.debug"))) {
   n <- length(.debug$stack)
   msg <- .debug$stack[n]
   .debug$stack <- .debug$stack[-n]
-  debug_indent(-1)
   mdebug(sprintf("%s done", msg), debug = debug)
 }
 
@@ -63,7 +43,6 @@ mdebugf_pop <- function(..., debug = isTRUE(getOption("future.debug"))) {
   n <- length(.debug$stack)
   msg <- .debug$stack[n]
   .debug$stack <- .debug$stack[-n]
-  debug_indent(-1)
   mdebug(sprintf("%s done", msg), debug = debug)
 }