1#' Get properties of the current or caller frame
2#'
3#' @description
4#'
5#' \Sexpr[results=rd, stage=render]{rlang:::lifecycle("experimental")}
6#'
7#' * The current frame is the execution context of the function that
8#'   is currently being evaluated.
9#'
10#' * The caller frame is the execution context of the function that
11#'   called the function currently being evaluated.
12#'
13#' See the [call stack][stack] topic for more information.
14#'
15#'
16#' @section Life cycle:
17#'
18#' These functions are experimental.
19#'
20#' @param n The number of generations to go back.
21#'
22#' @seealso [caller_env()] and [current_env()]
23#' @keywords internal
24#' @export
25caller_fn <- function(n = 1) {
26  with_options(lifecycle_disable_warnings = TRUE,
27    call_frame(n + 2)$fn
28  )
29}
30#' @rdname caller_fn
31#' @export
32current_fn <- function() {
33  with_options(lifecycle_disable_warnings = TRUE,
34    call_frame(2)$fn
35  )
36}
37
38#' Jump to or from a frame
39#'
40#' @description
41#'
42#' \Sexpr[results=rd, stage=render]{rlang:::lifecycle("questioning")}
43#'
44#' While [base::return()] can only return from the current local
45#' frame, these two functions will return from any frame on the
46#' current evaluation stack, between the global and the currently
47#' active context. They provide a way of performing arbitrary
48#' non-local jumps out of the function currently under evaluation.
49#'
50#' @section Life cycle:
51#'
52#' The support for `frame` object is soft-deprecated.  Please pass
53#' simple environments to `return_from()` and `return_to()`.
54#'
55#' These functions are in the questioning lifecycle because we are
56#' considering simpler alternatives.
57#'
58#' @param frame An environment, a frame object, or any object with an
59#'   [get_env()] method. The environment should be an evaluation
60#'   environment currently on the stack.
61#' @param value The return value.
62#'
63#' @details
64#'
65#' `return_from()` will jump out of `frame`. `return_to()` is a bit
66#' trickier. It will jump out of the frame located just before `frame`
67#' in the evaluation stack, so that control flow ends up in `frame`,
68#' at the location where the previous frame was called from.
69#'
70#' These functions should only be used rarely. These sort of non-local
71#' gotos can be hard to reason about in casual code, though they can
72#' sometimes be useful. Also, consider to use the condition system to
73#' perform non-local jumps.
74#'
75#'
76#' @keywords internal
77#' @export
78#' @examples
79#' # Passing fn() evaluation frame to g():
80#' fn <- function() {
81#'   val <- g(current_env())
82#'   cat("g returned:", val, "\n")
83#'   "normal return"
84#' }
85#' g <- function(env) h(env)
86#'
87#' # Here we return from fn() with a new return value:
88#' h <- function(env) return_from(env, "early return")
89#' fn()
90#'
91#' # Here we return to fn(). The call stack unwinds until the last frame
92#' # called by fn(), which is g() in that case.
93#' h <- function(env) return_to(env, "early return")
94#' fn()
95return_from <- function(frame, value = NULL) {
96  if (is_integerish(frame)) {
97    frame <- ctxt_frame(frame)$env
98  }
99
100  exit_env <- get_env(frame)
101  expr <- expr(return(!!value))
102  eval_bare(expr, exit_env)
103}
104
105#' @rdname return_from
106#' @export
107return_to <- function(frame, value = NULL) {
108  with_options(lifecycle_disable_warnings = TRUE, {
109    if (is_integerish(frame)) {
110      prev_pos <- frame - 1
111    } else {
112      env <- get_env(frame)
113      distance <- frame_position_current(env)
114      prev_pos <- distance - 1
115    }
116
117    prev_frame <- ctxt_frame(prev_pos)$env
118  })
119  return_from(prev_frame, value)
120}
121
122is_frame_env <- function(env) {
123  for (frame in sys.frames()) {
124    if (identical(env, frame)) {
125      return(TRUE)
126    }
127  }
128  FALSE
129}
130
131
132#' Inspect a call
133#'
134#' This function is useful for quick testing and debugging when you
135#' manipulate expressions and calls. It lets you check that a function
136#' is called with the right arguments. This can be useful in unit
137#' tests for instance. Note that this is just a simple wrapper around
138#' [base::match.call()].
139#'
140#' @param ... Arguments to display in the returned call.
141#' @export
142#' @examples
143#' call_inspect(foo(bar), "" %>% identity())
144call_inspect <- function(...) match.call()
145