delayed_variable

#' Create a delayed evaluation of a call
#' 
#' Works similarly to `delayAssign()`, except it works as part of an assignment.
#' Can only be called from within a function and must be directly part of a left-assignment
#' This can be used to pass things like R CMD Check for delayed variables, rather than
#' using `delayedAssign("x",call)` is the equivalent of `x <- delayed_variable(call)`


delayed_variable <- function(call){
  
  #Get the current call
  prev.call <- sys.call()
  attribs <- attributes(prev.call)
  
  # If srcref isn't there, then we're not coming from a function
  if(is.null(attribs) || !"srcref" %in% names(attribs)){
    stop("delayed_variable() can only be used as an assignment within a function.")
  } 
  
  # Extract the call including the assignment operator
  this_call <- parse(text=as.character(attribs$srcref))[[1]]
  
  
  # Check if this is an assignment `<-` or `=`
  if(!(identical(this_call[[1]],quote(`<-`)) ||
       identical(this_call[[1]],quote(`=`)))){
    stop("delayed_variable() can only be used as an assignment within a function.")
  }
  
  # Get the variable being assigned to as a symbol and a string
  var_sym <- this_call[[2]]
  var_str <- deparse(var_sym)
  
  #Get the parent frame that we will be assigining into
  p_frame <- parent.frame()
  var_env <- new.env(parent = p_frame)
  
  #Create a random string to be an identifier
  var_rand <- paste0(sample(c(letters,LETTERS),50,replace=TRUE),collapse="")
  
  #Put the variables into the environment
  var_env[["p_frame"]] <- p_frame
  var_env[["var_str"]] <- var_str
  var_env[["var_rand"]] <- var_rand
  
  # Create the function that will be bound to the variable.
  # Since this is an Active Binding (AB), we have three situations
  # i)   It is run without input, and thus the AB is
  #      being called on it's own (missing(input)),
  #      and thus it should evaluate and return the output of `call`
  # ii)  It is being run as the lhs of an assignment
  #      as part of the initial assignment phase, in which case
  #      we do nothing (i.e. input is the output of this function)
  # iii) It is being run as the lhs of a regular assignment,
  #      in which case, we want to overwrite the AB
  fun <- function(input){
    if(missing(input)){
        # No assignment: variable is being called on its own
        # So, we activate the delayed assignment call:
        res <- eval(call,p_frame)
        rm(list=var_str,envir=p_frame)
        assign(var_str,res,p_frame)
        res
      } else if(!inherits(input,"assign_delay") && 
                input != var_rand){
        # Attempting to assign to the variable
        # and it is not the initial definition
        # So we overwrite the active binding
        res <- eval(substitute(input),p_frame)
        rm(list=var_str,envir=p_frame)
        assign(var_str,res,p_frame)
        invisible(res)
      } 
     # Else: We are assigning and the assignee is the output
     #    of this function, in which case, we do nothing!
    
  }
  
  #Fix the call in the above eval to be the exact call
  # rather than a variable (useful for debugging)
  # This is in the line res <- eval(call,p_frame)
  body(fun)[[c(2,3,2,3,2)]] <- substitute(call)
  
  #Put the function inside the environment with all
  # all of the variables above
  environment(fun) <- var_env
  
  # Check if the variable already exists in the calling
  #  environment and if so, remove it
  if(exists(var_str,envir=p_frame)){
    rm(list=var_str,envir=p_frame)
  }
  
  # Create the AB 
  makeActiveBinding(var_sym,fun,p_frame)
  
  
  # Return a specific object to check for
  structure(var_rand,call="assign_delay")
}


f_norm <- function(x){
  y <- x + 10
  
  x <- 2*x
  
  y
}

f_delay <- function(x){
  y <- delayed_variable(x + 10)
  
  x <- 2*x
  
  y
  
}
f_norm(3)
f_delay(3)