/*
* Return the CONTENT of a VARIABLE with NAME.
* If the content is non-nil then bump its
* reference counter.
*/
ETERM *erl_var_content (const ETERM *ep, const char *name)
{
int i;
ETERM *vp;
if ((!ep) || (!name)) return NULL;
/* ASSERT(ep != NULL); */
switch(ERL_TYPE(ep))
{
case ERL_VARIABLE:
if (strcmp(ERL_VAR_NAME(ep), name) == 0) {
if ((vp = ERL_VAR_VALUE(ep)) != NULL) {
ERL_COUNT(vp)++;
return vp;
}
}
break;
case ERL_LIST:
while (ep && (ERL_TYPE(ep) != ERL_EMPTY_LIST)) {
if ((vp = erl_var_content(HEAD(ep), name))) return vp;
ep = TAIL(ep);
}
break;
case ERL_TUPLE:
for (i=0; i < ERL_TUPLE_SIZE(ep); i++)
if ((vp = erl_var_content(ERL_TUPLE_ELEMENT(ep, i), name)))
{
return vp;
}
break;
default:
/* variables can't occur in other types */
break;
}
/* nothing found ! */
return NULL;
}
/*
* Create an empty VARIABLE.
*/
ETERM *erl_mk_var(const char *s)
{
ETERM *ep;
if (!s) return NULL;
/* ASSERT(s != NULL); */
ep = erl_alloc_eterm(ERL_VARIABLE);
ERL_COUNT(ep) = 1;
ERL_VAR_LEN(ep) = strlen(s);
if ((ERL_VAR_NAME(ep) = strsave(s)) == NULL)
{
erl_free_term(ep);
erl_errno = ENOMEM;
return NULL;
}
ERL_VAR_VALUE(ep) = (ETERM *) NULL;
return ep;
}
int erl_print_term(FILE *fp, const ETERM *ep)
{
int j,i,doquote;
int ch_written = 0; /* counter of written chars */
if ((!fp) || (!ep)) return 0;
/* ASSERT(ep != NULL); */
j = i = doquote = 0;
switch(ERL_TYPE(ep))
{
case ERL_ATOM: {
char* adata = ERL_ATOM_PTR(ep);
/* FIXME: what if some weird locale is in use? */
if (!islower(adata[0]))
doquote = 1;
for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++)
{
doquote = !(isalnum(adata[i]) || (adata[i] == '_'));
}
if (doquote) {
putc('\'', fp);
ch_written++;
}
fputs(adata, fp);
ch_written += ERL_ATOM_SIZE(ep);
if (doquote) {
putc('\'', fp);
ch_written++;
}
break;
}
case ERL_VARIABLE:
if (!isupper((int)ERL_VAR_NAME(ep)[0])) {
doquote = 1;
putc('\'', fp);
ch_written++;
}
fputs(ERL_VAR_NAME(ep), fp);
ch_written += ERL_VAR_LEN(ep);
if (doquote) {
putc('\'', fp);
ch_written++;
}
break;
case ERL_PID:
ch_written += fprintf(fp, "<%s.%d.%d>",
ERL_PID_NODE(ep),
ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep));
break;
case ERL_PORT:
ch_written += fprintf(fp, "#Port");
break;
case ERL_REF:
ch_written += fprintf(fp, "#Ref");
break;
case ERL_EMPTY_LIST:
ch_written += fprintf(fp, "[]");
break;
case ERL_LIST:
if (is_printable_list(ep)) {
ch_written += print_string(fp, ep);
} else {
putc('[', fp);
ch_written++;
while (ERL_IS_CONS(ep)) {
ch_written += erl_print_term(fp, HEAD(ep));
ep = TAIL(ep);
if (ERL_IS_CONS(ep)) {
putc(',', fp);
ch_written++;
}
}
if (!ERL_IS_EMPTY_LIST(ep)) {
putc('|', fp);
ch_written++;
ch_written += erl_print_term(fp, ep);
}
putc(']', fp);
ch_written++;
}
break;
case ERL_TUPLE:
putc('{', fp);
ch_written++;
for (i=0; i < ERL_TUPLE_SIZE(ep); i++) {
ch_written += erl_print_term(fp, ERL_TUPLE_ELEMENT(ep, j++) );
if (i != ERL_TUPLE_SIZE(ep)-1) {
putc(',', fp);
ch_written++;
}
}
putc('}', fp);
ch_written++;
break;
case ERL_BINARY: {
int sz = (ERL_BIN_SIZE(ep) > 20) ? 20 : ERL_BIN_SIZE(ep);
unsigned char *ptr = ERL_BIN_PTR(ep);
ch_written += fprintf(fp, "#Bin<");
for (i = 0; i < sz; i++) {
putc(ptr[i], fp); ch_written++;
}
if (sz == 20) ch_written += fprintf(fp, "(%d)....>", ERL_BIN_SIZE(ep)-20);
else ch_written += fprintf(fp, ">");
break;
}
case ERL_INTEGER:
case ERL_SMALL_BIG:
ch_written += fprintf(fp, "%d", ERL_INT_VALUE(ep));
break;
case ERL_U_INTEGER:
case ERL_U_SMALL_BIG:
ch_written += fprintf(fp, "%d", ERL_INT_UVALUE(ep));
break;
case ERL_LONGLONG:
case ERL_U_LONGLONG:
ch_written += fprintf(fp, "%lld", ERL_LL_UVALUE(ep));
break;
case ERL_FLOAT:
ch_written += fprintf(fp, "%f", ERL_FLOAT_VALUE(ep));
break;
case ERL_FUNCTION:
ch_written += fprintf(fp, "#Fun<");
ch_written += erl_print_term(fp, ERL_FUN_MODULE(ep));
putc('.', fp);
ch_written++;
ch_written += erl_print_term(fp, ERL_FUN_INDEX(ep));
putc('.', fp);
ch_written++;
ch_written += erl_print_term(fp, ERL_FUN_UNIQ(ep));
putc('>', fp);
ch_written++;
break;
default:
ch_written = -10000;
erl_err_msg("<ERROR> erl_print_term: Bad type of term !");
}
return ch_written;
}
int erl_sprint_term(char *buf, const ETERM *ep)
{
int j,i,doquote;
int ch_written = 0; /* counter of written chars */
if ((!buf) || (!ep)) return 0;
/* ASSERT(ep != NULL); */
j = i = doquote = 0;
switch(ERL_TYPE(ep))
{
case ERL_ATOM:
/* FIXME: what if some weird locale is in use? */
if (!islower((int)ERL_ATOM_PTR(ep)[0]))
doquote = 1;
for (i = 0; !doquote && i < ERL_ATOM_SIZE(ep); i++)
{
doquote = !(isalnum((int)ERL_ATOM_PTR(ep)[i])
|| (ERL_ATOM_PTR(ep)[i] == '_'));
}
if (doquote) {
*buf++ = '\'';
ch_written++;
}
{
int len = ERL_ATOM_SIZE(ep);
strncpy(buf, ERL_ATOM_PTR(ep), len);
buf += len;
ch_written += len;
}
if (doquote) {
*buf++ = '\'';
ch_written++;
}
break;
case ERL_VARIABLE:
if (!isupper((int)ERL_VAR_NAME(ep)[0])) {
doquote = 1;
*buf++ = '\'';
ch_written++;
}
len = ERL_VAR_LEN(ep);
strncpy(buf, ERL_VAR_NAME(ep), len);
buf += len;
ch_written += len;
if (doquote) {
*buf++ = '\'';
ch_written++;
}
break;
case ERL_PID:
len = sprintf(buf, "<%s.%d.%d>",
ERL_PID_NODE(ep),
ERL_PID_NUMBER(ep), ERL_PID_SERIAL(ep));
buf += len;
ch_written += len;
break;
case ERL_PORT:
len = sprintf(buf , "#Port");
buf += len;
ch_written += len;
break;
case ERL_REF:
len = sprintf(buf , "#Ref");
buf += len;
ch_written += len;
break;
case ERL_EMPTY_LIST:
len = sprintf(buf , "[]");
buf += len;
ch_written += len;
break;
case ERL_LIST:
if (is_printable_list(ep)) {
ch_written += print_string(fp, ep);
} else {
putc('[', fp);
ch_written++;
while (ERL_IS_CONS(ep)) {
ch_written += erl_sprint_term(fp, HEAD(ep));
ep = TAIL(ep);
if (ERL_IS_CONS(ep)) {
putc(',', fp);
ch_written++;
}
}
if (!ERL_IS_EMPTY_LIST(ep)) {
putc('|', fp);
ch_written++;
ch_written += erl_sprint_term(fp, ep);
}
putc(']', fp);
ch_written++;
}
break;
case ERL_TUPLE:
putc('{', fp);
ch_written++;
for (i=0; i < ERL_TUPLE_SIZE(ep); i++) {
ch_written += erl_sprint_term(fp, ERL_TUPLE_ELEMENT(ep, j++) );
if (i != ERL_TUPLE_SIZE(ep)-1) {
putc(',', fp);
ch_written++;
}
}
putc('}', fp);
ch_written++;
break;
case ERL_BINARY:
len = sprintf(buf , "#Bin");
buf += len;
ch_written += len;
break;
case ERL_INTEGER:
case ERL_SMALL_BIG:
len = sprintf(buf , "%d", ERL_INT_VALUE(ep));
buf += len;
ch_written += len;
break;
case ERL_U_INTEGER:
case ERL_U_SMALL_BIG:
len = sprintf(buf , "%d", ERL_INT_UVALUE(ep));
buf += len;
ch_written += len;
break;
case ERL_FLOAT:
len = sprintf(buf , "%f", ERL_FLOAT_VALUE(ep));
buf += len;
ch_written += len;
break;
case ERL_FUNCTION:
len = sprintf(buf , "#Fun<");
buf += len;
ch_written += len;
ch_written += erl_sprint_term(fp, ERL_FUN_MODULE(ep));
putc('.', fp);
ch_written++;
ch_written += erl_sprint_term(fp, ERL_FUN_INDEX(ep));
putc('.', fp);
ch_written++;
ch_written += erl_sprint_term(fp, ERL_FUN_UNIQ(ep));
putc('>', fp);
ch_written++;
break;
default:
ch_written = -10000;
erl_err_msg("<ERROR> erl_sprint_term: Bad type of term !");
}
return ch_written;
}
/*
* Dump (print for debugging) a term. Useful if/when things go wrong.
*/
void
dump_term (FILE *fp, ETERM *t)
{
if (fp == NULL) return;
fprintf(fp, "#<%p ", t);
if(t != NULL)
{
fprintf(fp, "count:%d, type:%d", ERL_COUNT(t), ERL_TYPE(t));
switch(ERL_TYPE(t))
{
case ERL_UNDEF:
fprintf(fp, "==undef");
break;
case ERL_INTEGER:
fprintf(fp, "==int, val:%d", ERL_INT_VALUE(t));
break;
case ERL_U_INTEGER:
fprintf(fp, "==uint, val:%u", ERL_INT_UVALUE(t));
break;
case ERL_FLOAT:
fprintf(fp, "==float, val:%g", ERL_FLOAT_VALUE(t));
break;
case ERL_ATOM:
fprintf(fp, "==atom, name:%p \"%s\"",
ERL_ATOM_PTR(t), ERL_ATOM_PTR(t));
break;
case ERL_BINARY:
fprintf(fp, "==binary, data:%p,%u",
ERL_BIN_PTR(t), ERL_BIN_SIZE(t));
break;
case ERL_PID:
fprintf(fp, "==pid, node:%p \"%s\"",
ERL_PID_NODE(t), ERL_PID_NODE(t));
break;
case ERL_PORT:
fprintf(fp, "==port, node:%p \"%s\"",
ERL_PORT_NODE(t), ERL_PORT_NODE(t));
break;
case ERL_REF:
fprintf(fp, "==ref, node:%p \"%s\"",
ERL_REF_NODE(t), ERL_REF_NODE(t));
break;
case ERL_CONS:
fprintf(fp, "==cons");
fprintf(fp, ", car:");
dump_term(fp, ERL_CONS_HEAD(t));
fprintf(fp, ", cdr:");
dump_term(fp, ERL_CONS_TAIL(t));
break;
case ERL_NIL:
fprintf(fp, "==nil");
break;
case ERL_TUPLE:
fprintf(fp, "==tuple, elems:%p,%u",
ERL_TUPLE_ELEMS(t), ERL_TUPLE_SIZE(t));
{
size_t i;
for(i = 0; i < ERL_TUPLE_SIZE(t); i++)
{
fprintf(fp, "elem[%u]:", i);
dump_term(fp, ERL_TUPLE_ELEMENT(t, i));
}
}
break;
case ERL_VARIABLE:
fprintf(fp, "==variable, name:%p \"%s\"",
ERL_VAR_NAME(t), ERL_VAR_NAME(t));
fprintf(fp, ", value:");
dump_term(fp, ERL_VAR_VALUE(t));
break;
default:
break;
}
}
fprintf(fp, ">");
}
