1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86

use r_derive::*;

use crate::callable::core::*;
use crate::context::Context;
use crate::formals;
use crate::lang::*;
use crate::object::*;

/// Get the Parent of an Object
///
/// # In-Language
///
/// ## Usage
///
/// ```custom,{class=r}
/// parent(x)
/// ```
///
/// ## Arguments
///
/// * `x`: An object for which to fetch a parent. When not provided,
///     will return the parent of the current environment.
///
/// ## Examples
///
/// ```custom,{class=r-repl}
/// parent()
/// ```
///
#[doc(alias = "parent")]
#[builtin(sym = "parent")]
#[derive(Debug, Clone, PartialEq)]
pub struct PrimitiveParent;

formals!(PrimitiveParent, "(x,)");

impl Callable for PrimitiveParent {
    fn call(&self, args: ExprList, stack: &mut CallStack) -> EvalResult {
        let (vals, _) = self.match_arg_exprs(args, stack)?;
        let mut vals = Obj::List(vals);

        // default when `x` is missing or not found
        let x = vals.try_get_named("x");
        if let Ok(Obj::Promise(_, Expr::Missing, _)) | Err(_) = x {
            return Ok(stack
                .env()
                .parent
                .clone()
                .map_or(Obj::Null, Obj::Environment));
        };

        match vals.try_get_named("x")?.force(stack)?.environment() {
            Some(e) => Ok(e.parent.clone().map_or(Obj::Null, Obj::Environment)),
            None => Ok(Obj::Null),
        }
    }
}

#[cfg(test)]
mod test {
    use crate::{r, r_expect};

    #[test]
    fn no_args() {
        // assumes default environment has a parent... may change in the future
        r_expect! {
            parent(environment()) == parent()
        }
    }

    #[test]
    fn function_parent_env() {
        r_expect! {{"
            x <- function() { }
            parent(x) == parent()
        "}}
    }

    #[test]
    fn nested_function_parent_env() {
        r_expect! {{"
            x <- function() { function() {} }
            parent(x()) == environment(x)
        "}}
    }
}