1 #include <string.h>
2
3 #include "rlang.h"
4
5
6 // In old R versions `as.name()` does not translate to native which
7 // loses the encoding. This symbol constructor always translates.
r_new_symbol(sexp * x,int * err)8 sexp* r_new_symbol(sexp* x, int* err) {
9 switch (r_typeof(x)) {
10 case SYMSXP:
11 return x;
12 case STRSXP:
13 if (r_length(x) == 1) {
14 const char* string = Rf_translateChar(r_chr_get(x, 0));
15 return r_sym(string);
16 } // else fallthrough
17 default: {
18 if (err) {
19 *err = -1;
20 return r_null;
21 } else {
22 const char* type = r_type_as_c_string(r_typeof(x));
23 r_abort("Can't create a symbol with a %s", type);
24 }
25 }}
26 }
27
r_is_symbol(sexp * x,const char * string)28 bool r_is_symbol(sexp* x, const char* string) {
29 if (r_typeof(x) != SYMSXP) {
30 return false;
31 } else {
32 return strcmp(CHAR(PRINTNAME(x)), string) == 0;
33 }
34 }
35
r_is_symbol_any(sexp * x,const char ** strings,int n)36 bool r_is_symbol_any(sexp* x, const char** strings, int n) {
37 if (r_typeof(x) != SYMSXP) {
38 return false;
39 }
40
41 const char* name = CHAR(PRINTNAME(x));
42
43 for (int i = 0; i < n; ++i) {
44 if (strcmp(name, strings[i]) == 0) {
45 return true;
46 }
47 }
48
49 return false;
50 }
51
r_is_special_op_sym(sexp * x)52 bool r_is_special_op_sym(sexp* x) {
53 if (r_typeof(x) != SYMSXP) {
54 return false;
55 }
56
57 const char* name = CHAR(PRINTNAME(x));
58 int len = strlen(name);
59
60 return
61 len > 2 &&
62 name[0] == '%' &&
63 name[len - 1] == '%';
64 }
65
66
67 sexp* r_syms_dot_environment;
68 sexp* r_syms_function;
69 sexp* r_syms_srcref;
70 sexp* r_syms_tilde;
71
72 sexp* r_syms_w;
73 sexp* r_syms_x;
74 sexp* r_syms_y;
75 sexp* r_syms_z;
76
77 sexp* r_syms_dot_x;
78 sexp* r_syms_dot_y;
79 sexp* r_syms_dot_fn;
80
r_init_library_sym()81 void r_init_library_sym() {
82 r_syms_dot_environment = r_sym(".Environment");
83 r_syms_function = r_sym("function");
84 r_syms_srcref = r_sym("srcref");
85 r_syms_tilde = r_sym("~");
86
87 r_syms_w = r_sym("w");
88 r_syms_x = r_sym("x");
89 r_syms_y = r_sym("y");
90 r_syms_z = r_sym("z");
91
92 r_syms_dot_x = r_sym(".x");
93 r_syms_dot_y = r_sym(".y");
94 r_syms_dot_fn = r_sym(".fn");
95 }
96