rustr/rcast/
mod.rs

1//! Cast R Object type
2//!
3//!
4
5use protect::indexp::Armor;
6use ::error::*;
7use ::rdll::*;
8use eval::*;
9use ::traits::*;
10use ::error::REKind::*;
11use ::rtype::*;
12use util::c_str;
13use ::protect::stackp::*;
14
15#[inline]
16pub fn convert_using_rfunction(x: SEXP, fun: &str) -> SEXPResult {
17    unsafe {
18        let fun_r = ::std::ffi::CString::new(fun)?;
19        let fun_sym = Rf_install(fun_r.as_ptr());
20
21        let res: Armor;
22
23        // match one
24        res = match rustr_eval(Rf_lang2(fun_sym, x), R_GlobalEnv) {
25            Ok(x) => Armor::new(x),
26
27            // match two
28            Err(y) => {
29                match *y.kind() {
30                    // match two case one
31                    EvalError(_) => {
32                        return rerror(NotCompatible(format!("could not convert using R function \
33                                                             : {}",
34                                                            fun)
35                                                        .into()))
36                    }
37
38                    // match two case two
39                    _ => return rraise("unreachable error in convert_using_rfunction."),
40                }
41            } // end match two
42
43        };//end match one assign to res
44
45        Ok(res.s())
46    }
47
48}
49
50#[inline]
51pub fn r_true_cast(x: SEXP, into: Rtype) -> SEXPResult {
52    unsafe {
53        match into {
54
55            STRSXP => {
56                if RTYPEOF(x) == into {
57                    return Ok(x);
58                };
59                match RTYPEOF(x) {
60                    // 2 m 1 c
61                    CPLXSXP | RAWSXP | LGLSXP | REALSXP | INTSXP => {
62
63                        // return Rf_coerceVector( x, STRSXP );
64                        // coerceVector does not work for some reason
65                        let call = Shield::new(Rf_lang2(Rf_install(c_str("as.character")
66                                                                       .as_ptr()),
67                                                        x));
68                        let res = Shield::new(Rf_eval(call.s(), R_GlobalEnv));
69                        Ok(res.s())
70
71                    }
72                    // 2 m 2 c
73                    CHARSXP => Ok(Rf_ScalarString(x)),
74                    // 2 m 3 c
75                    SYMSXP => Ok(Rf_ScalarString(PRINTNAME(x))),
76                    // 2 m 4 c
77                    _ => rerror(NotCompatible("not compatible with STRSXP".into())),
78                }
79                // end m1 c1 mm
80
81            } //end m1 c1
82
83            REALSXP | RAWSXP | LGLSXP | CPLXSXP | INTSXP => {
84                if RTYPEOF(x) == into {
85                    return Ok(x);
86                };
87
88                match RTYPEOF(x) {
89                    REALSXP | RAWSXP | LGLSXP | CPLXSXP | INTSXP => {
90                        Ok(Rf_coerceVector(x, into as ::std::os::raw::c_uint))
91                    }
92                    _ => rerror(NotCompatible("not compatible with requested type".into())), 
93                }
94
95            } // end m1 c2
96
97            VECSXP => convert_using_rfunction(x, "as.list"),
98
99            EXPRSXP => convert_using_rfunction(x, "as.expression"),
100
101            LANGSXP => convert_using_rfunction(x, "as.call"),
102
103            LISTSXP => {
104                match RTYPEOF(x) {
105                    LANGSXP => {
106                        let y = Shield::new(Rf_duplicate(x));
107                        SET_RTYPEOF(y.s(), LISTSXP);
108                        Ok(y.s())
109                    }
110                    _ => convert_using_rfunction(x, "as.pairlist"),
111                }
112            }
113
114            _ => rerror(UnreachableError(format!("r_true_cast: {:?} to {}", x, into))),
115
116        }
117
118    } // unsafe
119}
120
121#[inline]
122pub fn r_cast(x: SEXP, into: Rtype) -> SEXPResult {
123    unsafe {
124        if RTYPEOF(x) == into {
125            Ok(x)
126        } else {
127            // #ifdef RCPP_WARN_ON_COERCE
128            let result = match r_true_cast(x, into) {
129                Ok(ins) => Shield::new(ins),
130                Err(er) => return rerror(Other(er.into())),
131            };
132
133            Rf_warning(c_str("coerced object from '%s' to '%s'").as_ptr(),
134                       R_CHAR(Rf_type2str(TYPEOF(x) as ::std::os::raw::c_uint)),
135                       R_CHAR(Rf_type2str(into as ::std::os::raw::c_uint)));
136
137            Ok(result.s())
138            // #else
139            // return internal::r_true_cast<TARGET>(x);
140            // #endif
141        }
142    }
143
144}
rustr/rcast/mod.rs

rustr/rcast/
mod.rs
