meta_call_current()

R/aaa-meta.R

@@ -1,4 +1,6 @@
 # Overwritten in meta.R
+meta_call_start <- function(...) {}
+meta_call_end <- function(...) {}
 meta_ext_register <- function(...) {}
 meta_rel_register <- function(...) {}
 meta_rel_register_df <- function(...) {}

R/meta.R

@@ -1,10 +1,26 @@
+call_stack <- collections::stack()
 pre_code_cache <- collections::queue()
 code_cache <- collections::queue()
 ext_cache <- collections::dict()
 macro_cache <- collections::dict()
 df_cache <- collections::dict()
 rel_cache <- collections::dict()
 
+meta_call_start <- function(name) {
+  call_stack$push(name)
+}
+
+meta_call_end <- function(name) {
+  call_stack$pop()
+}
+
+meta_call_current <- function() {
+  if (call_stack$size() == 0) {
+    return(NULL)
+  }
+  call_stack$peek()
+}
+
 meta_clear <- function() {
   pre_code_cache$clear()
   code_cache$clear()
@@ -213,8 +229,13 @@ meta_rel_register <- function(rel, rel_expr) {
   count <- rel_cache$size()
   name <- sym(paste0("rel", count + 1))
 
-  # https://github.com/cynkra/constructive/issues/102
+  current_call <- meta_call_current()
+  if (!is.null(current_call)) {
+    # FIXME: This is probably too convoluted
+    meta_record(constructive::deparse_call(expr(!!current_call)))
+  }
 
+  # https://github.com/cynkra/constructive/issues/102
   meta_record(constructive::deparse_call(expr(!!name <- !!rel_expr)))
 
   obj <- list(rel = rel, name = name, df = df)

R/relational.R

@@ -1,6 +1,11 @@
 rel_try <- function(rel, ..., call = NULL) {
   call_name <- as.character(sys.call(-1)[[1]])
 
+  if (!is.null(call$name)) {
+    meta_call_start(call$name)
+    withr::defer(meta_call_end(call$name))
+  }
+
   # Avoid error when called via dplyr:::filter.data.frame() (in yamlet)
   if (length(call_name) == 1 && !(call_name %in% stats$calls)) {
     stats$calls <- c(stats$calls, call_name)