Skip to content

Commit fdb9526

Browse files
duncanwernerduncanwerner
committed
unify and clean up sexp -> variant logic
1 parent c28beb7 commit fdb9526

File tree

2 files changed

+93
-148
lines changed

2 files changed

+93
-148
lines changed

‎BERT/BERT_Version.h‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
#ifndef __BERT_VERSION_H
2222
#define __BERT_VERSION_H
2323

24-
#define BERT_VERSION L"1.51.1"
24+
#define BERT_VERSION L"1.52.0"
2525

2626
#endif // #ifndef __BERT_VERSION_H
2727

‎BERT/RCOM.cpp‎

Lines changed: 92 additions & 147 deletions
Original file line numberDiff line numberDiff line change
@@ -847,6 +847,72 @@ void formatCOMError(std::string &target, HRESULT hr, const char *msg, const char
847847

848848
}
849849

850+
/**
851+
* tail method for converting sexp -> variant as safearray,
852+
* to support intrinsic types, lists and frames.
853+
*/
854+
void SEXPIntoArray( SEXP arg, VARIANT *arr, int &index, std::vector<CComBSTR*> &stringcache ) {
855+
856+
int len = Rf_length(arg);
857+
858+
if (Rf_isLogical(arg)) {
859+
for (int row = 0; row < len; row++, index++) {
860+
arr[index].vt = VT_BOOL;
861+
arr[index].boolVal = (bool)(INTEGER(arg)[row] != 0);
862+
}
863+
}
864+
else if (Rf_isInteger(arg)) {
865+
for (int row = 0; row < len; row++, index++) {
866+
arr[index].vt = VT_INT;
867+
arr[index].intVal = INTEGER(arg)[row];
868+
}
869+
}
870+
else if (Rf_isFactor(arg)) {
871+
872+
// map factor
873+
SEXP levels = Rf_getAttrib(arg, R_LevelsSymbol);
874+
int lcount = Rf_length(levels);
875+
std::vector< CComBSTR* > factor;
876+
for (int i = 0; i < lcount; i++) {
877+
CComBSTR *bstr = new CComBSTR();
878+
STRSXP2BSTR(*bstr, STRING_ELT(levels, i));
879+
factor.push_back(bstr);
880+
stringcache.push_back(bstr);
881+
}
882+
883+
for (int row = 0; row < len; row++, index++) {
884+
int level = INTEGER(arg)[row];
885+
arr[index].vt = VT_BSTR | VT_BYREF;
886+
arr[index].pbstrVal = &(factor[level - 1]->m_str);
887+
}
888+
}
889+
else if (Rf_isNumeric(arg)) {
890+
for (int row = 0; row < len; row++, index++) {
891+
arr[index].vt = VT_R8;
892+
arr[index].dblVal = REAL(arg)[row];
893+
}
894+
}
895+
else if (Rf_isString(arg)) {
896+
for (int row = 0; row < len; row++, index++) {
897+
CComBSTR *bstr = new CComBSTR();
898+
STRSXP2BSTR(*bstr, STRING_ELT(arg, row));
899+
arr[index].vt = VT_BSTR | VT_BYREF;
900+
arr[index].pbstrVal = &(bstr->m_str);
901+
stringcache.push_back(bstr);
902+
}
903+
}
904+
else if (Rf_isVector(arg) || Rf_isFrame(arg)) {
905+
for (int col = 0; col < len; col++) {
906+
SEXP x = VECTOR_ELT(arg, col);
907+
SEXPIntoArray(x, arr, index, stringcache);
908+
}
909+
}
910+
else {
911+
DebugOut("Unhandled type: %d\n", TYPEOF(arg));
912+
}
913+
914+
}
915+
850916
SEXP invokePropertyPut(std::string name, LPDISPATCH pdisp, SEXP value)
851917
{
852918
if (!pdisp) {
@@ -873,55 +939,39 @@ SEXP invokePropertyPut(std::string name, LPDISPATCH pdisp, SEXP value)
873939
dispparams.cNamedArgs = 1;
874940
dispparams.rgdispidNamedArgs = &dispidNamed;
875941

942+
// strings are passed byref, and we clean them up
943+
std::vector<CComBSTR*> stringcache;
944+
945+
// either a single value or an array
876946
CComVariant cv;
877-
CComBSTR bstr;
878947

879-
SEXP arg = value;
880-
int t;
881-
882948
// wrapped in an outside list to pass it in
883-
if ((Rf_length(arg) == 1) && (TYPEOF(arg) == VECSXP)) {
884-
arg = VECTOR_ELT(value, 0);
949+
if ((Rf_length(value) == 1) && (TYPEOF(value) == VECSXP)) {
950+
value = VECTOR_ELT(value, 0);
885951
}
886952

887953
// now check this element -- could be a list
888-
if (Rf_length(arg) <= 1) {
889-
890-
t = TYPEOF(value);
891-
if (t == VECSXP) {
892-
arg = VECTOR_ELT(value, 0);
893-
t = TYPEOF(arg);
894-
895-
}
896-
897-
if (Rf_isLogical(arg)) cv = (bool)(INTEGER(arg)[0] != 0);
898-
else if (Rf_isInteger(arg)) cv = INTEGER(arg)[0];
899-
else if (Rf_isNumeric(arg)) cv = REAL(arg)[0];
900-
else if (Rf_isString(arg)) {
901-
902-
STRSXP2BSTR(bstr, arg);
903-
cv.vt = VT_BSTR;
904-
cv.bstrVal = bstr;
905-
906-
}
907-
954+
if (Rf_length(value) <= 1) {
955+
int index = 0;
956+
SEXPIntoArray(value, &cv, index, stringcache);
908957
dispparams.rgvarg = &cv;
909958
hr = pdisp->Invoke(dispid, IID_NULL, 1033, DISPATCH_PROPERTYPUT, &dispparams, NULL, NULL, NULL);
910-
911959
}
912960
else {
913961

914-
int nr = Rf_nrows(arg);
915-
int nc = Rf_ncols(arg);
962+
// for matrices or vectors (not lists), we can get dimensions
963+
964+
int nr = Rf_nrows(value);
965+
int nc = Rf_ncols(value);
916966

917-
// if it's a frame, it's going to be represented as a VECSXP.
918-
// in this case len is the number of columns, and we need to look
967+
// if it's a frame, it's going to be represented as a VECSXP and
968+
// in this case len is the number of columns. we need to look
919969
// at the first column (or any column) to get the row count.
920970

921-
bool frame = Rf_isFrame(arg);
922-
if (frame && Rf_length(arg) > 0) {
923-
nc = Rf_length(arg);
924-
SEXP x = VECTOR_ELT(arg, 0);
971+
bool frame = Rf_isFrame(value);
972+
if (frame && Rf_length(value) > 0) {
973+
nc = Rf_length(value);
974+
SEXP x = VECTOR_ELT(value, 0);
925975
nr = x ? Rf_length(x) : 0;
926976
}
927977

@@ -933,131 +983,26 @@ SEXP invokePropertyPut(std::string name, LPDISPATCH pdisp, SEXP value)
933983

934984
CComSafeArray<VARIANT> cc;
935985
cc.Create(sab, 2);
936-
std::vector<CComBSTR*> bv;
937986

938-
VARIANT *pv;
939-
SafeArrayAccessData(cc, (void**)&pv);
987+
VARIANT *arrayptr;
988+
SafeArrayAccessData(cc, (void**)&arrayptr);
940989

941990
int index = 0;
942-
int len = nr * nc;
943-
944-
t = TYPEOF(arg);
945-
946-
if( Rf_isInteger(arg)) {
947-
int *src = INTEGER(arg);
948-
for (int i = 0; i < len; i++) { pv[i].vt = VT_INT; pv[i].intVal = src[i]; }
949-
}
950-
else if (Rf_isReal(arg)) {
951-
double *src = REAL(arg);
952-
for (int i = 0; i < len; i++) {
953-
pv[i].vt = VT_R8;
954-
pv[i].dblVal = src[i];
955-
}
956-
}
957-
else if (Rf_isLogical(arg)) {
958-
int *src = INTEGER(arg);
959-
for (int i = 0; i < len; i++) { pv[i].vt = VT_BOOL; pv[i].boolVal = (bool)(src[i] != 0); }
960-
}
961-
else if (Rf_isString(arg)) {
962-
for (int i = 0; i < len; i++) {
963-
CComBSTR *bstr = new CComBSTR();
964-
STRSXP2BSTR(*bstr, STRING_ELT(arg, i));
965-
pv[i].vt = VT_BSTR | VT_BYREF;
966-
pv[i].pbstrVal = &(bstr->m_str);
967-
bv.push_back(bstr);
968-
}
969-
}
970-
else if (frame) {
971-
int index = 0;
972-
for (int col = 0; col < nc; col++) {
973-
974-
SEXP x = VECTOR_ELT(arg, col);
975-
if (Rf_isLogical(x)) {
976-
for (int row = 0; row < nr; row++, index++) {
977-
pv[index].vt = VT_BOOL;
978-
pv[index].boolVal = (bool)(INTEGER(x)[row] != 0);
979-
}
980-
}
981-
else if (Rf_isInteger(x)) {
982-
for (int row = 0; row < nr; row++, index++) {
983-
pv[index].vt = VT_INT;
984-
pv[index].intVal = INTEGER(x)[row];
985-
}
986-
}
987-
else if (Rf_isFactor(x)) {
988-
989-
// map factor
990-
SEXP levels = Rf_getAttrib(x, R_LevelsSymbol);
991-
int lcount = Rf_length(levels);
992-
std::vector< CComBSTR* > factor;
993-
for (int i = 0; i < lcount; i++) {
994-
CComBSTR *bstr = new CComBSTR();
995-
STRSXP2BSTR(*bstr, STRING_ELT(levels, i));
996-
factor.push_back(bstr);
997-
bv.push_back(bstr);
998-
}
999-
1000-
for (int row = 0; row < nr; row++, index++) {
1001-
int level = INTEGER(x)[row];
1002-
pv[index].vt = VT_BSTR | VT_BYREF;
1003-
pv[index].pbstrVal = &(factor[level - 1]->m_str);
1004-
}
1005-
}
1006-
else if (Rf_isNumeric(x)) {
1007-
1008-
for (int row = 0; row < nr; row++, index++) {
1009-
pv[index].vt = VT_R8;
1010-
pv[index].dblVal = REAL(x)[row];
1011-
}
1012-
}
1013-
else if (Rf_isString(x)) {
1014-
for (int row = 0; row < nr; row++, index++) {
1015-
CComBSTR *bstr = new CComBSTR();
1016-
STRSXP2BSTR(*bstr, STRING_ELT(x, row));
1017-
pv[index].vt = VT_BSTR | VT_BYREF;
1018-
pv[index].pbstrVal = &(bstr->m_str);
1019-
bv.push_back(bstr);
1020-
}
1021-
}
1022-
else {
1023-
DebugOut("Unhandled type: %d\n", TYPEOF(x));
1024-
}
1025-
}
1026-
}
1027-
1028-
//else if (t == VECSXP) {
1029-
else if( Rf_isVector(arg)){
1030-
for (int i = 0; i < len; i++){
1031-
SEXP x = VECTOR_ELT(arg, i);
1032-
if (Rf_isLogical(x)) { pv[i].vt = VT_BOOL; pv[i].boolVal = (bool)(INTEGER(x)[0] != 0); }
1033-
else if (Rf_isInteger(x)) { pv[i].vt = VT_INT; pv[i].intVal = INTEGER(x)[0]; }
1034-
else if (Rf_isNumeric(x)) { pv[i].vt = VT_R8; pv[i].dblVal = REAL(x)[0]; }
1035-
else if (Rf_isString(x)) {
1036-
1037-
CComBSTR *bstr = new CComBSTR();
1038-
int tlen = Rf_length(x);
1039-
STRSXP2BSTR(*bstr, tlen == 1 ? x : STRING_ELT(x, 0));
1040-
pv[i].vt = VT_BSTR | VT_BYREF;
1041-
pv[i].pbstrVal = &(bstr->m_str);
1042-
bv.push_back(bstr);
1043-
}
1044-
}
1045-
}
1046-
991+
SEXPIntoArray(value, arrayptr, index, stringcache);
992+
1047993
SafeArrayUnaccessData(cc);
1048994

1049995
cv = cc;
1050996
dispparams.rgvarg = &cv;
1051997
hr = pdisp->Invoke(dispid, IID_NULL, 1033, DISPATCH_PROPERTYPUT, &dispparams, NULL, NULL, NULL);
1052998

1053-
// clean up strings
1054-
for (std::vector< CComBSTR* > ::iterator iter = bv.begin(); iter != bv.end(); iter++) delete(*iter);
1055-
1056-
// and array
999+
// clean up array
10571000
cc.Destroy();
10581001

10591002
}
10601003

1004+
// clean up strings
1005+
for (std::vector< CComBSTR* > ::iterator iter = stringcache.begin(); iter != stringcache.end(); iter++) delete(*iter);
10611006

10621007
if (FAILED(hr))
10631008
{

0 commit comments

Comments
 (0)