R: Examples for 'base::sys.parent'

### ** Examples
## No test: 
require(utils)

## Note: the first two examples will give different results
## if run by example().
ff <- function(x) gg(x)
gg <- function(y) sys.status()
str(ff(1))

List of 3
 $ sys.calls  :Dotted pair list of 42
  ..$ : language (function (packed, ...)  tryCatch({ ...
  ..$ : language tryCatch({     w <- which(packed == as.raw(0L))[1:3] ...
  .. ..- attr(*, "srcref")= 'srcref' int [1:8] 45 16 65 96 16 96 45 65
  .. .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
  ..$ : language tryCatchList(expr, classes, parentenv, handlers)
  ..$ : language tryCatchOne(expr, names, parentenv, handlers[[1L]])
  ..$ : language doTryCatch(return(expr), name, parentenv, handler)
  ..$ : language rcloud.support:::.http.request(url, query, body, headers)
  .. ..- attr(*, "srcref")= 'srcref' int [1:8] 58 9 58 72 9 72 58 58
  .. .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
  ..$ : language tools:::httpd(url, query, body, headers, ...)
  ..$ : language example2html(topic, pkg, env = if (identical(query["local"], "FALSE")) .GlobalEnv else NULL)
  ..$ : language .code2html_payload_browser("example", ecode, topic, package, Rhome = Rhome,      header.info = header.info, env = env)
  ..$ : language knitr::knit(text = rhtml, quiet = TRUE, envir = if (is.null(env)) new.env(parent = .GlobalEnv) else env)
  ..$ : language process_file(text, output)
  ..$ : language xfun:::handle_error(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error =| __truncated__ ...
  ..$ : language withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error = function(e) if (xfu| __truncated__
  ..$ : language process_group(group)
  ..$ : language call_block(x)
  ..$ : language block_exec(params)
  ..$ : language eng_r(options)
  ..$ : language in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE| __truncated__ ...
  ..$ : language in_dir(input_dir(), expr)
  ..$ : language evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options| __truncated__ ...
  ..$ : language evaluate::evaluate(...)
  ..$ : language withRestarts(with_handlers({     for (expr in tle$exprs) { ...
  ..$ : language withRestartList(expr, restarts)
  ..$ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
  ..$ : language doWithOneRestart(return(expr), restart)
  ..$ : language withRestartList(expr, restarts[-nr])
  ..$ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
  ..$ : language doWithOneRestart(return(expr), restart)
  ..$ : language withRestartList(expr, restarts[-nr])
  ..$ : language withOneRestart(expr, restarts[[1L]])
  ..$ : language doWithOneRestart(return(expr), restart)
  ..$ : language with_handlers({     for (expr in tle$exprs) { ...
  ..$ : language eval(call)
  ..$ : language eval(call)
  ..$ : language withCallingHandlers(code, message = function (cnd)  { ...
  ..$ : language withVisible(eval(expr, envir))
  ..$ : language eval(expr, envir)
  ..$ : language eval(expr, envir)
  ..$ : language str(ff(1))
  ..$ : language ff(1)
  ..$ : language gg(x)
  .. ..- attr(*, "srcref")= 'srcref' int [1:8] 9 7 9 23 7 23 9 9
  ..$ : language sys.status()
  .. ..- attr(*, "srcref")= 'srcref' int [1:8] 10 7 10 30 7 30 10 10
 $ sys.parents: int [1:42] 0 1 2 3 4 1 6 7 8 9 ...
 $ sys.frames :Dotted pair list of 42
  ..$ :<environment: 0x55ccfdcbad18> 
  ..$ :<environment: 0x55ccfeea24f8> 
  ..$ :<environment: 0x55ccfeea1df8> 
  ..$ :<environment: 0x55ccfeea1ab0> 
  ..$ :<environment: 0x55ccfeea1768> 
  ..$ :<environment: 0x55ccfeea6ca0> 
  ..$ :<environment: 0x55ccfef863e8> 
  ..$ :<environment: 0x55ccfefa57a0> 
  ..$ :<environment: 0x55ccff3f14b0> 
  ..$ :<environment: 0x55ccff4a6f70> 
  ..$ :<environment: 0x55ccff5e93e8> 
  ..$ :<environment: 0x55ccff786030> 
  ..$ :<environment: 0x55ccff785d58> 
  ..$ :<environment: 0x55ccff785850> 
  ..$ :<environment: 0x55ccff7b2108> 
  ..$ :<environment: 0x55ccff885d50> 
  ..$ :<environment: 0x55ccff8cfab0> 
  ..$ :<environment: 0x55ccff98c9b8> 
  ..$ :<environment: 0x55ccff98c830> 
  ..$ :<environment: 0x55ccff9935f0> 
  ..$ :<environment: 0x55ccff9aabd0> 
  ..$ :<environment: 0x55ccfdc3a3c8> 
  ..$ :<environment: 0x55ccfdc303b0> 
  ..$ :<environment: 0x55ccfdc305a8> 
  ..$ :<environment: 0x55ccfdc307a0> 
  ..$ :<environment: 0x55ccfdc30df8> 
  ..$ :<environment: 0x55ccfdc31060> 
  ..$ :<environment: 0x55ccfdc31258> 
  ..$ :<environment: 0x55ccfdc2d640> 
  ..$ :<environment: 0x55ccfdc2d8a8> 
  ..$ :<environment: 0x55ccfdc2daa0> 
  ..$ :<environment: 0x55ccfdc2e0f8> 
  ..$ :<environment: 0x55ccfdc2e520> 
  ..$ :<environment: 0x55ccfdc2e0f8> 
  ..$ :<environment: 0x55ccfdc2eb08> 
  ..$ :<environment: 0x55ccfdc2f0b8> 
  ..$ :<environment: 0x55ccfdc2f278> 
  ..$ :<environment: 0x55ccff5067e0> 
  ..$ :<environment: 0x55ccfdc297c8> 
  ..$ :<environment: 0x55ccfdc29950> 
  ..$ :<environment: 0x55ccfdc29a68> 
  ..$ :<environment: 0x55ccfdc29e58>

gg <- function(y) {
    ggg <- function() {
        cat("current frame is", sys.nframe(), "\n")
        cat("parents are", sys.parents(), "\n")
        print(sys.function(0)) # ggg
        print(sys.function(2)) # gg
    }
    if(y > 0) gg(y-1) else ggg()
}
gg(3)

current frame is 43 
parents are 0 1 2 3 4 1 6 7 8 9 10 11 11 11 14 15 16 17 18 17 20 21 22 23 24 23 26 27 26 29 30 21 32 33 32 21 21 37 38 39 40 41 42 
<srcref: file "" chars 14:12 to 19:5>
<environment: 0x55ccfe935900>
function (expr, ..., finally) 
{
    tryCatchList <- function(expr, names, parentenv, handlers) {
        nh <- length(names)
        if (nh > 1L) 
            tryCatchOne(tryCatchList(expr, names[-nh], parentenv, 
                handlers[-nh]), names[nh], parentenv, handlers[[nh]])
        else if (nh == 1L) 
            tryCatchOne(expr, names, parentenv, handlers[[1L]])
        else expr
    }
    tryCatchOne <- function(expr, name, parentenv, handler) {
        doTryCatch <- function(expr, name, parentenv, handler) {
            .Internal(.addCondHands(name, list(handler), parentenv, 
                environment(), FALSE))
            expr
        }
        value <- doTryCatch(return(expr), name, parentenv, handler)
        if (is.null(value[[1L]])) {
            msg <- .Internal(geterrmessage())
            call <- value[[2L]]
            cond <- simpleError(msg, call)
        }
        else if (is.character(value[[1L]])) {
            msg <- value[[1L]]
            call <- value[[2L]]
            cond <- simpleError(msg, call)
        }
        else cond <- value[[1L]]
        value[[3L]](cond)
    }
    if (!missing(finally)) 
        on.exit(finally)
    handlers <- list(...)
    classes <- names(handlers)
    parentenv <- parent.frame()
    if (length(classes) != length(handlers)) 
        stop("condition handlers must be specified with a condition class")
    tryCatchList(expr, classes, parentenv, handlers)
}
<bytecode: 0x55ccfb029070>
<environment: namespace:base>

t1 <- function() {
  aa <- "here"
  t2 <- function() {
    ## in frame 2 here
    cat("current frame is", sys.nframe(), "\n")
    str(sys.calls()) ## list with two components t1() and t2()
    cat("parents are frame numbers", sys.parents(), "\n") ## 0 1
    print(ls(envir = sys.frame(-1))) ## [1] "aa" "t2"
    invisible()
  }
  t2()
}
t1()

current frame is 40 
Dotted pair list of 40
 $ : language (function (packed, ...)  tryCatch({ ...
 $ : language tryCatch({     w <- which(packed == as.raw(0L))[1:3] ...
  ..- attr(*, "srcref")= 'srcref' int [1:8] 45 16 65 96 16 96 45 65
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
 $ : language tryCatchList(expr, classes, parentenv, handlers)
 $ : language tryCatchOne(expr, names, parentenv, handlers[[1L]])
 $ : language doTryCatch(return(expr), name, parentenv, handler)
 $ : language rcloud.support:::.http.request(url, query, body, headers)
  ..- attr(*, "srcref")= 'srcref' int [1:8] 58 9 58 72 9 72 58 58
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
 $ : language tools:::httpd(url, query, body, headers, ...)
 $ : language example2html(topic, pkg, env = if (identical(query["local"], "FALSE")) .GlobalEnv else NULL)
 $ : language .code2html_payload_browser("example", ecode, topic, package, Rhome = Rhome,      header.info = header.info, env = env)
 $ : language knitr::knit(text = rhtml, quiet = TRUE, envir = if (is.null(env)) new.env(parent = .GlobalEnv) else env)
 $ : language process_file(text, output)
 $ : language xfun:::handle_error(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error =| __truncated__ ...
 $ : language withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error = function(e) if (xfu| __truncated__
 $ : language process_group(group)
 $ : language call_block(x)
 $ : language block_exec(params)
 $ : language eng_r(options)
 $ : language in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE| __truncated__ ...
 $ : language in_dir(input_dir(), expr)
 $ : language evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options| __truncated__ ...
 $ : language evaluate::evaluate(...)
 $ : language withRestarts(with_handlers({     for (expr in tle$exprs) { ...
 $ : language withRestartList(expr, restarts)
 $ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language withRestartList(expr, restarts[-nr])
 $ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language withRestartList(expr, restarts[-nr])
 $ : language withOneRestart(expr, restarts[[1L]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language with_handlers({     for (expr in tle$exprs) { ...
 $ : language eval(call)
 $ : language eval(call)
 $ : language withCallingHandlers(code, message = function (cnd)  { ...
 $ : language withVisible(eval(expr, envir))
 $ : language eval(expr, envir)
 $ : language eval(expr, envir)
 $ : language t1()
 $ : language t2()
parents are frame numbers 0 1 2 3 4 1 6 7 8 9 10 11 11 11 14 15 16 17 18 17 20 21 22 23 24 23 26 27 26 29 30 21 32 33 32 21 21 37 38 39 
[1] "aa" "t2"

test.sys.on.exit <- function() {
  on.exit(print(1))
  ex <- sys.on.exit()
  str(ex)
  cat("exiting...\n")
}
test.sys.on.exit()

 language print(1)
exiting...
[1] 1

## gives 'language print(1)', prints 1 on exit

## An example where the parent is not the next frame up the stack
## since method dispatch uses a frame.
as.double.foo <- function(x)
{
    str(sys.calls())
    print(sys.frames())
    print(sys.parents())
    print(sys.frame(-1)); print(parent.frame())
    x
}
t2 <- function(x) as.double(x)
a <- structure(pi, class = "foo")
t2(a)

Dotted pair list of 41
 $ : language (function (packed, ...)  tryCatch({ ...
 $ : language tryCatch({     w <- which(packed == as.raw(0L))[1:3] ...
  ..- attr(*, "srcref")= 'srcref' int [1:8] 45 16 65 96 16 96 45 65
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
 $ : language tryCatchList(expr, classes, parentenv, handlers)
 $ : language tryCatchOne(expr, names, parentenv, handlers[[1L]])
 $ : language doTryCatch(return(expr), name, parentenv, handler)
 $ : language rcloud.support:::.http.request(url, query, body, headers)
  ..- attr(*, "srcref")= 'srcref' int [1:8] 58 9 58 72 9 72 58 58
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x55ccfccba040> 
 $ : language tools:::httpd(url, query, body, headers, ...)
 $ : language example2html(topic, pkg, env = if (identical(query["local"], "FALSE")) .GlobalEnv else NULL)
 $ : language .code2html_payload_browser("example", ecode, topic, package, Rhome = Rhome,      header.info = header.info, env = env)
 $ : language knitr::knit(text = rhtml, quiet = TRUE, envir = if (is.null(env)) new.env(parent = .GlobalEnv) else env)
 $ : language process_file(text, output)
 $ : language xfun:::handle_error(withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error =| __truncated__ ...
 $ : language withCallingHandlers(if (tangle) process_tangle(group) else process_group(group),      error = function(e) if (xfu| __truncated__
 $ : language process_group(group)
 $ : language call_block(x)
 $ : language block_exec(params)
 $ : language eng_r(options)
 $ : language in_input_dir(evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE| __truncated__ ...
 $ : language in_dir(input_dir(), expr)
 $ : language evaluate(code, envir = env, new_device = FALSE, keep_warning = if (is.numeric(options$warning)) TRUE else options| __truncated__ ...
 $ : language evaluate::evaluate(...)
 $ : language withRestarts(with_handlers({     for (expr in tle$exprs) { ...
 $ : language withRestartList(expr, restarts)
 $ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language withRestartList(expr, restarts[-nr])
 $ : language withOneRestart(withRestartList(expr, restarts[-nr]), restarts[[nr]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language withRestartList(expr, restarts[-nr])
 $ : language withOneRestart(expr, restarts[[1L]])
 $ : language doWithOneRestart(return(expr), restart)
 $ : language with_handlers({     for (expr in tle$exprs) { ...
 $ : language eval(call)
 $ : language eval(call)
 $ : language withCallingHandlers(code, message = function (cnd)  { ...
 $ : language withVisible(eval(expr, envir))
 $ : language eval(expr, envir)
 $ : language eval(expr, envir)
 $ : language t2(a)
 $ : language as.double(x)
  ..- attr(*, "srcref")= 'srcref' int [1:8] 57 7 57 30 7 30 57 57
 $ : language as.double.foo(x)
  ..- attr(*, "srcref")= 'srcref' int [1:8] 57 7 57 30 7 30 57 57
[[1]]
<environment: 0x55ccfdcbad18>

[[2]]
<environment: 0x55ccfeea24f8>

[[3]]
<environment: 0x55ccfeea1df8>

[[4]]
<environment: 0x55ccfeea1ab0>

[[5]]
<environment: 0x55ccfeea1768>

[[6]]
<environment: 0x55ccfeea6ca0>

[[7]]
<environment: 0x55ccfef863e8>

[[8]]
<environment: 0x55ccfefa57a0>

[[9]]
<environment: 0x55ccff3f14b0>

[[10]]
<environment: 0x55ccff4a6f70>

[[11]]
<environment: 0x55ccff5e93e8>

[[12]]
<environment: 0x55ccff786030>

[[13]]
<environment: 0x55ccff785d58>

[[14]]
<environment: 0x55ccff785850>

[[15]]
<environment: 0x55ccff7b2108>

[[16]]
<environment: 0x55ccff885d50>

[[17]]
<environment: 0x55ccff8cfab0>

[[18]]
<environment: 0x55ccff98c9b8>

[[19]]
<environment: 0x55ccff98c830>

[[20]]
<environment: 0x55ccff9935f0>

[[21]]
<environment: 0x55ccff9aabd0>

[[22]]
<environment: 0x55ccff549768>

[[23]]
<environment: 0x55ccff559288>

[[24]]
<environment: 0x55ccff559090>

[[25]]
<environment: 0x55ccff558e98>

[[26]]
<environment: 0x55ccff55dcf0>

[[27]]
<environment: 0x55ccff55da88>

[[28]]
<environment: 0x55ccff55d628>

[[29]]
<environment: 0x55ccff55ce48>

[[30]]
<environment: 0x55ccff55ca58>

[[31]]
<environment: 0x55ccff55c828>

[[32]]
<environment: 0x55ccff561ae8>

[[33]]
<environment: 0x55ccff567910>

[[34]]
<environment: 0x55ccff561ae8>

[[35]]
<environment: 0x55ccff567328>

[[36]]
<environment: 0x55ccff566d78>

[[37]]
<environment: 0x55ccff566bb8>

[[38]]
<environment: 0x55ccff5067e0>

[[39]]
<environment: 0x55ccff566950>

[[40]]
<environment: 0x55ccff566800>

[[41]]
<environment: 0x55ccff5665d0>

 [1]  0  1  2  3  4  1  6  7  8  9 10 11 11 11 14 15 16 17 18 17 20 21 22 23 24
[26] 23 26 27 26 29 30 21 32 33 32 21 21 37 38 39 39
<environment: 0x55ccff566800>
<environment: 0x55ccff566950>

[1] 3.141593
attr(,"class")
[1] "foo"

## End(No test)

Examples for 'base::sys.parent'

Functions to Access the Function Call Stack