本文整理汇总了C++中CAR函数的典型用法代码示例。如果您正苦于以下问题：C++ CAR函数的具体用法？C++ CAR怎么用？C++ CAR使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了CAR函数的15个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于系统推荐出更棒的C++代码示例。
示例1: copy_struct
Eterm copy_struct(Eterm obj, Uint sz, Eterm** hpp, ErlOffHeap* off_heap)
#endif
{
char* hstart;
Uint hsize;
Eterm* htop;
Eterm* hbot;
Eterm* hp;
Eterm* objp;
Eterm* tp;
Eterm res;
Eterm elem;
Eterm* tailp;
Eterm* argp;
Eterm* const_tuple;
Eterm hdr;
int i;
#ifdef DEBUG
Eterm org_obj = obj;
Uint org_sz = sz;
#endif
if (IS_CONST(obj))
return obj;
DTRACE1(copy_struct, (int32_t)sz);
hp = htop = *hpp;
hbot = htop + sz;
hstart = (char *)htop;
hsize = (char*) hbot - hstart;
const_tuple = 0;
/* Copy the object onto the heap */
switch (primary_tag(obj)) {
case TAG_PRIMARY_LIST:
argp = &res;
objp = list_val_rel(obj,src_base);
goto L_copy_list;
case TAG_PRIMARY_BOXED: argp = &res; goto L_copy_boxed;
default:
erl_exit(ERTS_ABORT_EXIT,
"%s, line %d: Internal error in copy_struct: 0x%08x\n",
__FILE__, __LINE__,obj);
}
L_copy:
while (hp != htop) {
obj = *hp;
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1:
hp++;
break;
case TAG_PRIMARY_LIST:
objp = list_val_rel(obj,src_base);
#if !HALFWORD_HEAP || defined(DEBUG)
if (in_area(objp,hstart,hsize)) {
ASSERT(!HALFWORD_HEAP);
hp++;
break;
}
#endif
argp = hp++;
/* Fall through */
L_copy_list:
tailp = argp;
for (;;) {
tp = tailp;
elem = CAR(objp);
if (IS_CONST(elem)) {
hbot -= 2;
CAR(hbot) = elem;
tailp = &CDR(hbot);
}
else {
CAR(htop) = elem;
#if HALFWORD_HEAP
CDR(htop) = CDR(objp);
*tailp = make_list_rel(htop,dst_base);
htop += 2;
goto L_copy;
#else
tailp = &CDR(htop);
htop += 2;
#endif
}
ASSERT(!HALFWORD_HEAP || tp < hp || tp >= hbot);
*tp = make_list_rel(tailp - 1, dst_base);
obj = CDR(objp);
if (!is_list(obj)) {
break;
}
objp = list_val_rel(obj,src_base);
}
switch (primary_tag(obj)) {
case TAG_PRIMARY_IMMED1: *tailp = obj; goto L_copy;
case TAG_PRIMARY_BOXED: argp = tailp; goto L_copy_boxed;
default:
//.........这里部分代码省略.........
示例2: c_test_handler
static cv_t c_test_handler(obj_t cont, obj_t values)
{
obj_t ex = vector_ref(record_get_field(CAR(values), 0), 0);
return cv(EMPTY_LIST, MAKE_LIST(ex));
}示例3: MatrixSubset
static SEXP MatrixSubset(SEXP x, SEXP s, SEXP call, int drop)
{
SEXP attr, result, sr, sc, dim;
int nr, nc, nrs, ncs;
R_xlen_t i, j, ii, jj, ij, iijj;
nr = nrows(x);
nc = ncols(x);
/* Note that "s" is protected on entry. */
/* The following ensures that pointers remain protected. */
dim = getAttrib(x, R_DimSymbol);
sr = SETCAR(s, int_arraySubscript(0, CAR(s), dim, x, call));
sc = SETCADR(s, int_arraySubscript(1, CADR(s), dim, x, call));
nrs = LENGTH(sr);
ncs = LENGTH(sc);
/* Check this does not overflow: currently only possible on 32-bit */
if ((double)nrs * (double)ncs > R_XLEN_T_MAX)
error(_("dimensions would exceed maximum size of array"));
PROTECT(sr);
PROTECT(sc);
result = allocVector(TYPEOF(x), (R_xlen_t) nrs * (R_xlen_t) ncs);
PROTECT(result);
for (i = 0; i < nrs; i++) {
ii = INTEGER(sr)[i];
if (ii != NA_INTEGER) {
if (ii < 1 || ii > nr)
errorcall(call, R_MSG_subs_o_b);
ii--;
}
for (j = 0; j < ncs; j++) {
jj = INTEGER(sc)[j];
if (jj != NA_INTEGER) {
if (jj < 1 || jj > nc)
errorcall(call, R_MSG_subs_o_b);
jj--;
}
ij = i + j * nrs;
if (ii == NA_INTEGER || jj == NA_INTEGER) {
switch (TYPEOF(x)) {
case LGLSXP:
case INTSXP:
INTEGER(result)[ij] = NA_INTEGER;
break;
case REALSXP:
REAL(result)[ij] = NA_REAL;
break;
case CPLXSXP:
COMPLEX(result)[ij].r = NA_REAL;
COMPLEX(result)[ij].i = NA_REAL;
break;
case STRSXP:
SET_STRING_ELT(result, ij, NA_STRING);
break;
case VECSXP:
SET_VECTOR_ELT(result, ij, R_NilValue);
break;
case RAWSXP:
RAW(result)[ij] = (Rbyte) 0;
break;
default:
errorcall(call, _("matrix subscripting not handled for this type"));
break;
}
}
else {
iijj = ii + jj * nr;
switch (TYPEOF(x)) {
case LGLSXP:
LOGICAL(result)[ij] = LOGICAL(x)[iijj];
break;
case INTSXP:
INTEGER(result)[ij] = INTEGER(x)[iijj];
break;
case REALSXP:
REAL(result)[ij] = REAL(x)[iijj];
break;
case CPLXSXP:
COMPLEX(result)[ij] = COMPLEX(x)[iijj];
break;
case STRSXP:
SET_STRING_ELT(result, ij, STRING_ELT(x, iijj));
break;
case VECSXP:
SET_VECTOR_ELT(result, ij, VECTOR_ELT_FIX_NAMED(x, iijj));
break;
case RAWSXP:
RAW(result)[ij] = RAW(x)[iijj];
break;
default:
errorcall(call, _("matrix subscripting not handled for this type"));
break;
}
}
}
}
if(nrs >= 0 && ncs >= 0) {
PROTECT(attr = allocVector(INTSXP, 2));
INTEGER(attr)[0] = nrs;
//.........这里部分代码省略.........
示例4: CAR
void CallProxy::traverse_call( SEXP obj ){
if( TYPEOF(obj) == LANGSXP && CAR(obj) == Rf_install("local") ) return ;
if( ! Rf_isNull(obj) ){
SEXP head = CAR(obj) ;
switch( TYPEOF( head ) ){
case LANGSXP:
if( CAR(head) == Rf_install("order_by") ) break ;
if( CAR(head) == Rf_install("function") ) break ;
if( CAR(head) == Rf_install("local") ) return ;
if( CAR(head) == Rf_install("<-") ){
stop( "assignments are forbidden" ) ;
}
if( Rf_length(head) == 3 ){
SEXP symb = CAR(head) ;
if( symb == R_DollarSymbol || symb == Rf_install("@") || symb == Rf_install("::") || symb == Rf_install(":::") ){
// for things like : foo( bar = bling )$bla
// so that `foo( bar = bling )` gets processed
if( TYPEOF(CADR(head)) == LANGSXP ){
traverse_call( CDR(head) ) ;
}
// deal with foo$bar( bla = boom )
if( TYPEOF(CADDR(head)) == LANGSXP ){
traverse_call( CDDR(head) ) ;
}
break ;
} else {
traverse_call( CDR(head) ) ;
}
} else {
traverse_call( CDR(head) ) ;
}
break ;
case LISTSXP:
traverse_call( head ) ;
traverse_call( CDR(head) ) ;
break ;
case SYMSXP:
if( TYPEOF(obj) != LANGSXP ){
if( ! subsets.count(head) ){
if( head == R_MissingArg ) break ;
if( head == Rf_install(".") ) break ;
// in the Environment -> resolve
try{
Shield<SEXP> x( env.find( CHAR(PRINTNAME(head)) ) ) ;
SETCAR( obj, x );
} catch( ...){
// what happens when not found in environment
}
} else {
// in the data frame
proxies.push_back( CallElementProxy( head, obj ) );
}
break ;
}
}
traverse_call( CDR(obj) ) ;
}
}示例5: BGl_inlinezd2walkz12zc0zzinline_walkz00
/* inline-walk! */
BGL_EXPORTED_DEF obj_t BGl_inlinezd2walkz12zc0zzinline_walkz00(obj_t
BgL_globalsz00_1, obj_t BgL_whatz00_2)
{
AN_OBJECT;
{ /* Inline/walk.scm 40 */
{ /* Inline/walk.scm 42 */
obj_t BgL_list3278z00_786;
{ /* Inline/walk.scm 42 */
obj_t BgL_arg3280z00_788;
{ /* Inline/walk.scm 42 */
obj_t BgL_arg3282z00_790;
BgL_arg3282z00_790 = MAKE_PAIR(BCHAR(((unsigned char) '\n')), BNIL);
BgL_arg3280z00_788 =
MAKE_PAIR(BGl_string3393z00zzinline_walkz00, BgL_arg3282z00_790);
}
BgL_list3278z00_786 =
MAKE_PAIR(BGl_string3394z00zzinline_walkz00, BgL_arg3280z00_788);
}
BGl_verbosez00zztools_speekz00(BINT(((long) 1)), BgL_list3278z00_786);
}
BGl_za2nbzd2errorzd2onzd2passza2zd2zztools_errorz00 = BINT(((long) 0));
BGl_za2currentzd2passza2zd2zzengine_passz00 =
BGl_string3393z00zzinline_walkz00;
{ /* Inline/walk.scm 42 */
obj_t BgL_g3270z00_791;
obj_t BgL_g3271z00_792;
{ /* Inline/walk.scm 42 */
obj_t BgL_list3292z00_806;
BgL_list3292z00_806 =
MAKE_PAIR(BGl_resetzd2statz12zd2envz12zzinline_walkz00, BNIL);
BgL_g3270z00_791 = BgL_list3292z00_806;
}
BgL_g3271z00_792 = CNST_TABLE_REF(((long) 1));
{
obj_t BgL_hooksz00_794;
obj_t BgL_hnamesz00_795;
BgL_hooksz00_794 = BgL_g3270z00_791;
BgL_hnamesz00_795 = BgL_g3271z00_792;
BgL_zc3anonymousza33283ze3z83_796:
if (NULLP(BgL_hooksz00_794))
{ /* Inline/walk.scm 42 */
CNST_TABLE_REF(((long) 2));
}
else
{ /* Inline/walk.scm 42 */
bool_t BgL_testz00_1352;
{ /* Inline/walk.scm 42 */
obj_t BgL_fun3291z00_804;
BgL_fun3291z00_804 = CAR(BgL_hooksz00_794);
BgL_testz00_1352 =
CBOOL(PROCEDURE_ENTRY(BgL_fun3291z00_804) (BgL_fun3291z00_804,
BEOA));
}
if (BgL_testz00_1352)
{
obj_t BgL_hnamesz00_1359;
obj_t BgL_hooksz00_1357;
BgL_hooksz00_1357 = CDR(BgL_hooksz00_794);
BgL_hnamesz00_1359 = CDR(BgL_hnamesz00_795);
BgL_hnamesz00_795 = BgL_hnamesz00_1359;
BgL_hooksz00_794 = BgL_hooksz00_1357;
goto BgL_zc3anonymousza33283ze3z83_796;
}
else
{ /* Inline/walk.scm 42 */
BGl_internalzd2errorzd2zztools_errorz00
(BGl_string3393z00zzinline_walkz00,
BGl_string3395z00zzinline_walkz00, CAR(BgL_hnamesz00_795));
}
}
}
}
BGl_inlinezd2setupz12zc0zzinline_walkz00(BgL_whatz00_2);
{
obj_t BgL_l3275z00_808;
BgL_l3275z00_808 = BgL_globalsz00_1;
BgL_zc3anonymousza33293ze3z83_809:
if (PAIRP(BgL_l3275z00_808))
{ /* Inline/walk.scm 46 */
{ /* Inline/walk.scm 47 */
obj_t BgL_gz00_811;
BgL_gz00_811 = CAR(BgL_l3275z00_808);
{ /* Inline/walk.scm 47 */
obj_t BgL_kfactorz00_812;
//.........这里部分代码省略.........
示例6: obj_compare
int obj_compare(obj_ptr left, obj_ptr right)
{
/* TODO
if (NUMP(left) && NUMP(right))
...
*/
if (TYPE(left) < TYPE(right))
return -1;
if (TYPE(left) > TYPE(right))
return 1;
switch (TYPE(left))
{
case TYPE_INT:
case TYPE_BOOL:
return _int_compare(INT(left), INT(right));
case TYPE_FLOAT:
return _float_compare(FLOAT(left), FLOAT(right), 0.00000001); /* TODO: Better epsilon? */
case TYPE_SYMBOL:
return strcmp(SYMBOL(left), SYMBOL(right));
case TYPE_STRING:
return string_compare(&STRING(left), &STRING(right));
case TYPE_CONS:
{
int res = 0;
for (;;)
{
if (NTYPEP(left, TYPE(right)))
return obj_compare(left, right);
if (NTYPEP(left, TYPE_CONS))
return obj_compare(left, right);
res = obj_compare(CAR(left), CAR(right));
if (res != 0)
return res;
left = CDR(left);
right = CDR(right);
}
assert(0); /* unreachable */
break;
}
case TYPE_VEC:
return vec_compare(&left->data.as_vec, &right->data.as_vec);
/* TODO */
case TYPE_MAP:
assert(TYPE(left) != TYPE_MAP);
break;
case TYPE_CLOSURE:
assert(TYPE(left) != TYPE_CLOSURE);
break;
case TYPE_PRIMITIVE:
assert(TYPE(left) != TYPE_PRIMITIVE);
break;
case TYPE_ERROR:
assert(TYPE(left) != TYPE_ERROR);
break;
case TYPE_PORT:
assert(TYPE(left) != TYPE_PORT);
break;
}
return 0;
}示例7: eval
static SCM
eval (SCM x, SCM env)
{
SCM mx;
SCM proc = SCM_UNDEFINED, args = SCM_EOL;
unsigned int argc;
loop:
SCM_TICK;
if (!SCM_MEMOIZED_P (x))
abort ();
mx = SCM_MEMOIZED_ARGS (x);
switch (SCM_MEMOIZED_TAG (x))
{
case SCM_M_SEQ:
eval (CAR (mx), env);
x = CDR (mx);
goto loop;
case SCM_M_IF:
if (scm_is_true (EVAL1 (CAR (mx), env)))
x = CADR (mx);
else
x = CDDR (mx);
goto loop;
case SCM_M_LET:
{
SCM inits = CAR (mx);
SCM new_env = CAPTURE_ENV (env);
for (; scm_is_pair (inits); inits = CDR (inits))
new_env = scm_cons (EVAL1 (CAR (inits), env),
new_env);
env = new_env;
x = CDR (mx);
goto loop;
}
case SCM_M_LAMBDA:
RETURN_BOOT_CLOSURE (mx, CAPTURE_ENV (env));
case SCM_M_QUOTE:
return mx;
case SCM_M_DEFINE:
scm_define (CAR (mx), EVAL1 (CDR (mx), env));
return SCM_UNSPECIFIED;
case SCM_M_DYNWIND:
{
SCM in, out, res;
scm_i_thread *t = SCM_I_CURRENT_THREAD;
in = EVAL1 (CAR (mx), env);
out = EVAL1 (CDDR (mx), env);
scm_call_0 (in);
scm_dynstack_push_dynwind (&t->dynstack, in, out);
res = eval (CADR (mx), env);
scm_dynstack_pop (&t->dynstack);
scm_call_0 (out);
return res;
}
case SCM_M_WITH_FLUIDS:
{
long i, len;
SCM *fluidv, *valuesv, walk, res;
scm_i_thread *thread = SCM_I_CURRENT_THREAD;
len = scm_ilength (CAR (mx));
fluidv = alloca (sizeof (SCM)*len);
for (i = 0, walk = CAR (mx); i < len; i++, walk = CDR (walk))
fluidv[i] = EVAL1 (CAR (walk), env);
valuesv = alloca (sizeof (SCM)*len);
for (i = 0, walk = CADR (mx); i < len; i++, walk = CDR (walk))
valuesv[i] = EVAL1 (CAR (walk), env);
scm_dynstack_push_fluids (&thread->dynstack, len, fluidv, valuesv,
thread->dynamic_state);
res = eval (CDDR (mx), env);
scm_dynstack_unwind_fluids (&thread->dynstack, thread->dynamic_state);
return res;
}
case SCM_M_APPLY:
/* Evaluate the procedure to be applied. */
proc = EVAL1 (CAR (mx), env);
/* Evaluate the argument holding the list of arguments */
args = EVAL1 (CADR (mx), env);
apply_proc:
/* Go here to tail-apply a procedure. PROC is the procedure and
* ARGS is the list of arguments. */
if (BOOT_CLOSURE_P (proc))
{
prepare_boot_closure_env_for_apply (proc, args, &x, &env);
goto loop;
}
else
//.........这里部分代码省略.........
示例8: iol2v_continue
static BIF_RETTYPE iol2v_continue(iol2v_state_t *state) {
Eterm iterator;
DECLARE_ESTACK(s);
ESTACK_CHANGE_ALLOCATOR(s, ERTS_ALC_T_SAVED_ESTACK);
state->bytereds_available =
ERTS_BIF_REDS_LEFT(state->process) * IOL2V_SMALL_BIN_LIMIT;
state->bytereds_spent = 0;
if (state->estack.start) {
ESTACK_RESTORE(s, &state->estack);
}
iterator = state->input_list;
for(;;) {
if (state->bytereds_spent >= state->bytereds_available) {
ESTACK_SAVE(s, &state->estack);
state->input_list = iterator;
return iol2v_yield(state);
}
while (is_list(iterator)) {
Eterm *cell;
Eterm head;
cell = list_val(iterator);
head = CAR(cell);
if (is_binary(head)) {
if (!iol2v_append_binary(state, head)) {
goto l_badarg;
}
iterator = CDR(cell);
} else if (is_small(head)) {
Eterm seq_end;
if (!iol2v_append_byte_seq(state, iterator, &seq_end)) {
goto l_badarg;
}
iterator = seq_end;
} else if (is_list(head) || is_nil(head)) {
Eterm tail = CDR(cell);
if (!is_nil(tail)) {
ESTACK_PUSH(s, tail);
}
state->bytereds_spent += 1;
iterator = head;
} else {
goto l_badarg;
}
if (state->bytereds_spent >= state->bytereds_available) {
ESTACK_SAVE(s, &state->estack);
state->input_list = iterator;
return iol2v_yield(state);
}
}
if (is_binary(iterator)) {
if (!iol2v_append_binary(state, iterator)) {
goto l_badarg;
}
} else if (!is_nil(iterator)) {
goto l_badarg;
}
if(ESTACK_ISEMPTY(s)) {
break;
}
iterator = ESTACK_POP(s);
}
if (state->acc_size != 0) {
iol2v_enqueue_result(state, iol2v_promote_acc(state));
}
BUMP_REDS(state->process, state->bytereds_spent / IOL2V_SMALL_BIN_LIMIT);
CLEAR_SAVED_ESTACK(&state->estack);
DESTROY_ESTACK(s);
BIF_RET(state->result_head);
l_badarg:
CLEAR_SAVED_ESTACK(&state->estack);
DESTROY_ESTACK(s);
if (state->acc != NULL) {
erts_bin_free(state->acc);
state->acc = NULL;
}
//.........这里部分代码省略.........
示例9: erts_ioq_iolist_to_vec
int
erts_ioq_iolist_to_vec(Eterm obj, /* io-list */
SysIOVec* iov, /* io vector */
ErtsIOQBinary** binv, /* binary reference vector */
ErtsIOQBinary* cbin, /* binary to store characters */
Uint bin_limit, /* small binaries limit */
int driver)
{
DECLARE_ESTACK(s);
Eterm* objp;
byte *buf = NULL;
Uint len = 0;
Uint csize = 0;
int vlen = 0;
byte* cptr;
if (cbin) {
if (driver) {
buf = (byte*)cbin->driver.orig_bytes;
len = cbin->driver.orig_size;
} else {
buf = (byte*)cbin->nif.orig_bytes;
len = cbin->nif.orig_size;
}
}
cptr = buf;
goto L_jump_start; /* avoid push */
while (!ESTACK_ISEMPTY(s)) {
obj = ESTACK_POP(s);
L_jump_start:
if (is_list(obj)) {
L_iter_list:
objp = list_val(obj);
obj = CAR(objp);
if (is_byte(obj)) {
if (len == 0)
goto L_overflow;
*buf++ = unsigned_val(obj);
csize++;
len--;
} else if (is_binary(obj)) {
ESTACK_PUSH(s, CDR(objp));
goto handle_binary;
} else if (is_list(obj)) {
ESTACK_PUSH(s, CDR(objp));
goto L_iter_list; /* on head */
} else if (!is_nil(obj)) {
goto L_type_error;
}
obj = CDR(objp);
if (is_list(obj))
goto L_iter_list; /* on tail */
else if (is_binary(obj)) {
goto handle_binary;
} else if (!is_nil(obj)) {
goto L_type_error;
}
} else if (is_binary(obj)) {
Eterm real_bin;
Uint offset;
Eterm* bptr;
Uint size;
int bitoffs;
int bitsize;
handle_binary:
size = binary_size(obj);
ERTS_GET_REAL_BIN(obj, real_bin, offset, bitoffs, bitsize);
ASSERT(bitsize == 0);
bptr = binary_val(real_bin);
if (*bptr == HEADER_PROC_BIN) {
ProcBin* pb = (ProcBin *) bptr;
if (bitoffs != 0) {
if (len < size) {
goto L_overflow;
}
erts_copy_bits(pb->bytes+offset, bitoffs, 1,
(byte *) buf, 0, 1, size*8);
csize += size;
buf += size;
len -= size;
} else if (bin_limit && size < bin_limit) {
if (len < size) {
goto L_overflow;
}
sys_memcpy(buf, pb->bytes+offset, size);
csize += size;
buf += size;
len -= size;
} else {
ErtsIOQBinary *qbin;
if (csize != 0) {
io_list_to_vec_set_vec(&iov, &binv, cbin,
cptr, csize, &vlen);
cptr = buf;
csize = 0;
}
if (pb->flags) {
//.........这里部分代码省略.........
示例10: BGl_fetchzd2prototypeszd2zz__match_expandz00
/* fetch-prototypes */
obj_t BGl_fetchzd2prototypeszd2zz__match_expandz00(obj_t BgL_patz00_2)
{
AN_OBJECT;
{ /* Match/mexpand.scm 112 */
if (CBOOL(BGl_memqz00zz__r4_pairs_and_lists_6_3z00(CAR(BgL_patz00_2),
BGl_list2321z00zz__match_expandz00)))
{ /* Match/mexpand.scm 114 */
obj_t BgL_arg1957z00_876;
obj_t BgL_arg1958z00_877;
{ /* Match/mexpand.scm 114 */
obj_t BgL_arg1959z00_878;
obj_t BgL_arg1960z00_879;
{ /* Match/mexpand.scm 114 */
obj_t BgL_pairz00_1432;
BgL_pairz00_1432 = BgL_patz00_2;
BgL_arg1959z00_878 = CAR(CDR(CDR(BgL_pairz00_1432)));
}
{ /* Match/mexpand.scm 114 */
obj_t BgL_arg1961z00_880;
{ /* Match/mexpand.scm 114 */
obj_t BgL_arg1965z00_883;
{ /* Match/mexpand.scm 114 */
obj_t BgL_pairz00_1438;
BgL_pairz00_1438 = BgL_patz00_2;
BgL_arg1965z00_883 = CAR(CDR(BgL_pairz00_1438));
}
BgL_arg1961z00_880 =
BGl_patternzd2variableszd2zz__match_descriptionsz00
(BgL_arg1965z00_883);
}
{ /* Match/mexpand.scm 114 */
obj_t BgL_list1963z00_882;
BgL_list1963z00_882 = MAKE_PAIR(BNIL, BNIL);
BgL_arg1960z00_879 =
BGl_consza2za2zz__r4_pairs_and_lists_6_3z00
(BgL_arg1961z00_880, BgL_list1963z00_882);
}
}
BgL_arg1957z00_876 =
MAKE_PAIR(BgL_arg1959z00_878, BgL_arg1960z00_879);
}
{ /* Match/mexpand.scm 115 */
obj_t BgL_arg1966z00_884;
{ /* Match/mexpand.scm 115 */
obj_t BgL_pairz00_1442;
BgL_pairz00_1442 = BgL_patz00_2;
BgL_arg1966z00_884 = CAR(CDR(CDR(CDR(BgL_pairz00_1442))));
}
BgL_arg1958z00_877 =
BGl_fetchzd2prototypeszd2zz__match_expandz00(BgL_arg1966z00_884);
}
return MAKE_PAIR(BgL_arg1957z00_876, BgL_arg1958z00_877);
}
else
{ /* Match/mexpand.scm 113 */
return BNIL;
}
}
}示例11: BGl_expandzd2matchzd2casez00zz__match_expandz00
/* expand-match-case */
BGL_EXPORTED_DEF obj_t BGl_expandzd2matchzd2casez00zz__match_expandz00(obj_t
BgL_expz00_5)
{
AN_OBJECT;
{ /* Match/mexpand.scm 123 */
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1973z00_891;
obj_t BgL_arg1974z00_892;
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1977z00_895;
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1979z00_896;
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1980z00_897;
obj_t BgL_arg1981z00_898;
BgL_arg1980z00_897 = BGl_symbol2324z00zz__match_expandz00;
{ /* Match/mexpand.scm 124 */
obj_t BgL_pairz00_1462;
BgL_pairz00_1462 = BgL_expz00_5;
BgL_arg1981z00_898 = CDR(CDR(BgL_pairz00_1462));
}
BgL_arg1979z00_896 =
MAKE_PAIR(BgL_arg1980z00_897, BgL_arg1981z00_898);
}
if (EXTENDED_PAIRP(BgL_expz00_5))
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1970z00_1469;
obj_t BgL_arg1971z00_1470;
obj_t BgL_arg1972z00_1471;
BgL_arg1970z00_1469 = CAR(BgL_arg1979z00_896);
BgL_arg1971z00_1470 = CDR(BgL_arg1979z00_896);
BgL_arg1972z00_1471 = CER(BgL_expz00_5);
{ /* Match/mexpand.scm 124 */
obj_t BgL_res2294z00_1479;
BgL_res2294z00_1479 =
MAKE_EXTENDED_PAIR(BgL_arg1970z00_1469, BgL_arg1971z00_1470,
BgL_arg1972z00_1471);
BgL_arg1977z00_895 = BgL_res2294z00_1479;
}
}
else
{ /* Match/mexpand.scm 124 */
BgL_arg1977z00_895 = BgL_arg1979z00_896;
}
}
BgL_arg1973z00_891 =
BGl_expandzd2matchzd2lambdaz00zz__match_expandz00
(BgL_arg1977z00_895);
}
{ /* Match/mexpand.scm 125 */
obj_t BgL_pairz00_1480;
BgL_pairz00_1480 = BgL_expz00_5;
BgL_arg1974z00_892 = CAR(CDR(BgL_pairz00_1480));
}
{ /* Match/mexpand.scm 124 */
obj_t BgL_list1975z00_893;
{ /* Match/mexpand.scm 124 */
obj_t BgL_arg1976z00_894;
BgL_arg1976z00_894 = MAKE_PAIR(BgL_arg1974z00_892, BNIL);
BgL_list1975z00_893 =
MAKE_PAIR(BgL_arg1973z00_891, BgL_arg1976z00_894);
}
return BgL_list1975z00_893;
}
}
}
}示例12: BGl_zc3anonymousza31896ze3z83zz__match_expandz00
/* <anonymous:1896> */
obj_t BGl_zc3anonymousza31896ze3z83zz__match_expandz00(obj_t BgL_envz00_1693,
obj_t BgL_patz00_1695, obj_t BgL_envz00_1696)
{
AN_OBJECT;
{ /* Match/mexpand.scm 96 */
{ /* Match/mexpand.scm 97 */
obj_t BgL_expz00_1694;
BgL_expz00_1694 = PROCEDURE_REF(BgL_envz00_1693, (int) (((long) 0)));
{
obj_t BgL_patz00_803;
obj_t BgL_envz00_804;
BgL_patz00_803 = BgL_patz00_1695;
BgL_envz00_804 = BgL_envz00_1696;
{ /* Match/mexpand.scm 97 */
obj_t BgL_compiledzd2patzd2_806;
obj_t BgL_prototypesz00_807;
BgL_compiledzd2patzd2_806 =
BGl_pcompilez00zz__match_compilerz00(BgL_patz00_803);
BgL_prototypesz00_807 =
BGl_fetchzd2prototypeszd2zz__match_expandz00(BgL_patz00_803);
{ /* Match/mexpand.scm 101 */
obj_t BgL_arg1898z00_808;
obj_t BgL_arg1899z00_809;
BgL_arg1898z00_808 = BGl_symbol2319z00zz__match_expandz00;
{ /* Match/mexpand.scm 102 */
obj_t BgL_arg1900z00_810;
{ /* Match/mexpand.scm 102 */
obj_t BgL_arg1904z00_814;
if (NULLP(BgL_prototypesz00_807))
{ /* Match/mexpand.scm 102 */
BgL_arg1904z00_814 = BNIL;
}
else
{ /* Match/mexpand.scm 102 */
obj_t BgL_head1850z00_818;
BgL_head1850z00_818 = MAKE_PAIR(BNIL, BNIL);
{
obj_t BgL_l1848z00_820;
obj_t BgL_tail1851z00_821;
BgL_l1848z00_820 = BgL_prototypesz00_807;
BgL_tail1851z00_821 = BgL_head1850z00_818;
BgL_zc3anonymousza31907ze3z83_822:
if (NULLP(BgL_l1848z00_820))
{ /* Match/mexpand.scm 102 */
BgL_arg1904z00_814 = CDR(BgL_head1850z00_818);
}
else
{ /* Match/mexpand.scm 102 */
obj_t BgL_newtail1852z00_824;
{ /* Match/mexpand.scm 102 */
obj_t BgL_arg1910z00_826;
{ /* Match/mexpand.scm 102 */
obj_t BgL_prototypez00_828;
BgL_prototypez00_828 = CAR(BgL_l1848z00_820);
{ /* Match/mexpand.scm 104 */
obj_t BgL_bodyz00_829;
BgL_bodyz00_829 =
CDR(BGl_assqz00zz__r4_pairs_and_lists_6_3z00
(CAR(BgL_prototypez00_828),
BgL_envz00_804));
if (NULLP(BgL_bodyz00_829))
{ /* Match/mexpand.scm 105 */
BgL_arg1910z00_826 =
BGl_errorz00zz__errorz00
(BGl_symbol2316z00zz__match_expandz00,
BGl_string2318z00zz__match_expandz00,
BgL_expz00_1694);
}
else
{ /* Match/mexpand.scm 107 */
obj_t BgL_arg1914z00_831;
obj_t BgL_arg1915z00_832;
BgL_arg1914z00_831 =
CAR(BgL_prototypez00_828);
{ /* Match/mexpand.scm 108 */
obj_t BgL_arg1916z00_833;
{ /* Match/mexpand.scm 108 */
obj_t BgL_pairz00_1402;
BgL_pairz00_1402 =
//.........这里部分代码省略.........
示例13: BGl_expandzd2matchzd2lambdaz00zz__match_expandz00
/* expand-match-lambda */
BGL_EXPORTED_DEF obj_t BGl_expandzd2matchzd2lambdaz00zz__match_expandz00(obj_t
BgL_expz00_1)
{
AN_OBJECT;
{ /* Match/mexpand.scm 71 */
{
obj_t BgL_clausesz00_798;
obj_t BgL_kz00_799;
{ /* Match/mexpand.scm 95 */
obj_t BgL_arg1894z00_801;
BgL_arg1894z00_801 = CDR(BgL_expz00_1);
{ /* Match/mexpand.scm 97 */
obj_t BgL_zc3anonymousza31896ze3z83_1689;
BgL_zc3anonymousza31896ze3z83_1689 =
make_fx_procedure
(BGl_zc3anonymousza31896ze3z83zz__match_expandz00,
(int) (((long) 2)), (int) (((long) 1)));
PROCEDURE_SET(BgL_zc3anonymousza31896ze3z83_1689,
(int) (((long) 0)), BgL_expz00_1);
BgL_clausesz00_798 = BgL_arg1894z00_801;
BgL_kz00_799 = BgL_zc3anonymousza31896ze3z83_1689;
BgL_clauseszd2ze3patternz31_800:
if (NULLP(BgL_clausesz00_798))
{ /* Match/mexpand.scm 75 */
return
PROCEDURE_ENTRY(BgL_kz00_799) (BgL_kz00_799,
BGl_list2305z00zz__match_expandz00,
BGl_za2thezd2emptyzd2envza2z00zz__match_expandz00, BEOA);
}
else
{ /* Match/mexpand.scm 77 */
bool_t BgL_testz00_1737;
{ /* Match/mexpand.scm 77 */
obj_t BgL_auxz00_1738;
BgL_auxz00_1738 = CAR(BgL_clausesz00_798);
BgL_testz00_1737 = PAIRP(BgL_auxz00_1738);
}
if (BgL_testz00_1737)
{ /* Match/mexpand.scm 80 */
obj_t BgL_patternz00_840;
obj_t BgL_actionsz00_841;
obj_t BgL_restz00_842;
{ /* Match/mexpand.scm 80 */
obj_t BgL_pairz00_1414;
BgL_pairz00_1414 = BgL_clausesz00_798;
BgL_patternz00_840 = CAR(CAR(BgL_pairz00_1414));
}
{ /* Match/mexpand.scm 81 */
obj_t BgL_pairz00_1418;
BgL_pairz00_1418 = BgL_clausesz00_798;
BgL_actionsz00_841 = CDR(CAR(BgL_pairz00_1418));
}
BgL_restz00_842 = CDR(BgL_clausesz00_798);
{ /* Match/mexpand.scm 83 */
obj_t BgL_tagz00_843;
BgL_tagz00_843 =
PROCEDURE_ENTRY(BGl_jimzd2gensymzd2zz__match_s2cfunz00)
(BGl_jimzd2gensymzd2zz__match_s2cfunz00,
BGl_string2311z00zz__match_expandz00, BEOA);
if ((BgL_patternz00_840 ==
BGl_symbol2312z00zz__match_expandz00))
{ /* Match/mexpand.scm 85 */
obj_t BgL_arg1923z00_845;
obj_t BgL_arg1924z00_846;
{ /* Match/mexpand.scm 85 */
obj_t BgL_arg1925z00_847;
obj_t BgL_arg1926z00_848;
BgL_arg1925z00_847 =
BGl_symbol2314z00zz__match_expandz00;
{ /* Match/mexpand.scm 85 */
obj_t BgL_arg1927z00_849;
obj_t BgL_arg1929z00_850;
BgL_arg1927z00_849 =
MAKE_PAIR(BGl_symbol2309z00zz__match_expandz00,
BNIL);
{ /* Match/mexpand.scm 85 */
obj_t BgL_arg1937z00_855;
obj_t BgL_arg1938z00_856;
BgL_arg1937z00_855 =
//.........这里部分代码省略.........
示例14: reader_getc
//.........这里部分代码省略.........
else
{
r->state->dotpair_mode = 1;
reader_putc (r, nc);
}
}
else
{
/* Turn it into a decimal point. */
reader_putc (r, nc);
reader_putc (r, '.');
reader_putc (r, '0');
}
break;
/* Whitespace */
case '\n':
r->linecnt++;
print_prompt (r);
case ' ':
case '\t':
case '\r':
break;
/* Parenthesis */
case '(':
push (r);
break;
case ')':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Vectors */
case '[':
push (r);
r->state->vector_mode = 1;
break;
case ']':
if (r->state->quote_mode)
read_error (r, "unbalanced parenthesis");
else if (!r->state->vector_mode)
read_error (r, "unbalanced brackets");
else
addpop (r);
break;
/* Quoting */
case '\'':
push (r);
add (r, quote);
if (!r->error)
r->state->quote_mode = 1;
break;
/* strings */
case '"':
buf_read (r, "\"");
add (r, parse_str (r));
reader_getc (r); /* Throw away other quote. */
break;
/* numbers and symbols */
default:
buf_append (r, c);
buf_read (r, " \t\r\n()[];");
object_t *o = parse_atom (r);
if (!r->error)
add (r, o);
break;
}
}
if (!r->eof && !r->error)
consume_whitespace (r);
if (r->error)
return err_symbol;
/* Check state */
r->done = 1;
if (stack_height (r) > 1 || r->state->quote_mode
|| r->state->dotpair_mode == 1)
{
read_error (r, "premature end of file");
return err_symbol;
}
if (list_empty (r))
{
obj_destroy (pop (r));
return NIL;
}
object_t *wrap = pop (r);
object_t *sexp = UPREF (CAR (wrap));
obj_destroy (wrap);
return sexp;
}示例15: RK_TRACE
//.........这里部分代码省略.........
childdata->length = childcount;
RData **children = new RData*[childcount];
childdata->data = children;
childdata->length = childcount;
for (unsigned int i = 0; i < childcount; ++i) { // in case there is an error while fetching one of the children, let's pre-initialize everything.
children[i] = new RData;
children[i]->data = 0;
children[i]->length = 0;
children[i]->datatype = RData::NoData;
}
if (do_env) {
RK_DO (qDebug ("recurse into environment %s", name.toLatin1().data ()), RBACKEND, DL_DEBUG);
for (unsigned int i = 0; i < childcount; ++i) {
SEXP current_childname = install(CHAR(STRING_ELT(childnames_s, i)));
PROTECT (current_childname);
SEXP child = Rf_findVar (current_childname, value);
PROTECT (child);
bool child_misplaced = false;
if (with_namespace) {
/* before R 2.4.0, operator "::" would only work on true namespaces, not on package names (operator "::" work, if there is a namespace, and that namespace has the symbol in it)
TODO remove once we depend on R >= 2.4.0 */
# ifndef R_2_5
if (Rf_isNull (namespace_envir)) {
child_misplaced = true;
} else {
SEXP dummy = Rf_findVarInFrame (namespace_envir, current_childname);
if (Rf_isNull (dummy) || (dummy == R_UnboundValue)) child_misplaced = true;
}
/* for R 2.4.0 or greater: operator "::" works if package has no namespace at all, or has a namespace with the symbol in it */
# else
if (!Rf_isNull (namespace_envir)) {
SEXP dummy = Rf_findVarInFrame (namespace_envir, current_childname);
if (Rf_isNull (dummy) || (dummy == R_UnboundValue)) child_misplaced = true;
}
# endif
}
getStructureSafe (child, childnames[i], child_misplaced, children[i]);
UNPROTECT (2); /* childname, child */
}
} else if (do_cont) {
RK_DO (qDebug ("recurse into list %s", name.toLatin1().data ()), RBACKEND, DL_DEBUG);
// fewer elements than names() can happen, although I doubt it is supposed to happen.
// see http://sourceforge.net/tracker/?func=detail&aid=3002439&group_id=50231&atid=459007
bool may_be_special = Rf_length (value) < childcount;
if (Rf_isList (value) && (!may_be_special)) { // old style list
for (unsigned int i = 0; i < childcount; ++i) {
SEXP child = CAR (value);
getStructureSafe (child, childnames[i], false, children[i]);
CDR (value);
}
} else if (Rf_isNewList (value) && (!may_be_special)) { // new style list
for (unsigned int i = 0; i < childcount; ++i) {
SEXP child = VECTOR_ELT(value, i);
getStructureSafe (child, childnames[i], false, children[i]);
}
} else { // probably an S4 object disguised as a list
SEXP index = Rf_allocVector(INTSXP, 1);
PROTECT (index);
for (unsigned int i = 0; i < childcount; ++i) {
INTEGER (index)[0] = (i + 1);
SEXP child = callSimpleFun2 (double_brackets_fun, value, index, R_BaseEnv);
getStructureSafe (child, childnames[i], false, children[i]);
}
UNPROTECT (1); /* index */
}
}
UNPROTECT (1); /* childnames_s */
delete [] childnames;
} else if (is_function) {
RData *funargsdata = new RData;
funargsdata->datatype = RData::StringVector;
funargsdata->length = 0;
funargsdata->data = 0;
res[5] = funargsdata;
RData *funargvaluesdata = new RData;
funargvaluesdata->datatype = RData::StringVector;
funargvaluesdata->length = 0;
funargvaluesdata->data = 0;
res[6] = funargvaluesdata;
// TODO: this is still the major bottleneck, but no idea, how to improve on this
SEXP formals_s = callSimpleFun (get_formals_fun, value, R_GlobalEnv);
PROTECT (formals_s);
// the default values
funargvaluesdata->data = SEXPToStringList (formals_s, &(funargvaluesdata->length));
// the argument names
SEXP names_s = getAttrib (formals_s, R_NamesSymbol);
PROTECT (names_s);
funargsdata->data = SEXPToStringList (names_s, &(funargsdata->length));
UNPROTECT (2); /* names_s, formals_s */
}
UNPROTECT (1); /* value */
}