static Expr* mul(Expr* args) {
assert(args);
double dbuf = 1.0;
long long lbuf = 1;
bool exact = true;
while(scm_is_pair(args)) {
Expr* cur = scm_car(args);
if(scm_is_int(cur)) {
lbuf *= scm_ival(cur);
dbuf *= scm_ival(cur);
} else if(scm_is_real(cur)) {
exact = false;
dbuf *= scm_rval(cur);
} else {
return scm_mk_error("Wrong type of argument to *");
}
args = scm_cdr(args);
}
if(args != EMPTY_LIST) {
return scm_mk_error("args to * aren't a proper list");
}
return exact ? scm_mk_int(lbuf) : scm_mk_real(dbuf);
}
static Expr* sub(Expr* args) {
assert(args);
if(args == EMPTY_LIST) return scm_mk_error("no arguments passed to - (expected at least 1)");
// unary case
if(scm_cdr(args) == EMPTY_LIST) {
Expr* v = scm_car(args);
if(scm_is_int(v)) return scm_mk_int(-scm_ival(v));
if(scm_is_real(v)) return scm_mk_int(-scm_rval(v));
return scm_mk_error("wrong type of argument to -");
}
Expr* first = scm_car(args);
if(!scm_is_num(first)) return scm_mk_error("wrong type of argument to -");
bool exact = scm_is_int(first);
double dbuf = exact ? scm_ival(first) : scm_rval(first);
long long lbuf = exact ? scm_ival(first) : 0;
args = scm_cdr(args);
while(scm_is_pair(args)) {
Expr* cur = scm_car(args);
if(scm_is_int(cur)) {
lbuf -= scm_ival(cur);
dbuf -= scm_ival(cur);
} else if(scm_is_real(cur)) {
exact = false;
dbuf -= scm_rval(cur);
} else {
return scm_mk_error("Wrong type of argument to +");
}
args = scm_cdr(args);
}
if(args != EMPTY_LIST) {
return scm_mk_error("args to + aren't a proper list");
}
return exact ? scm_mk_int(lbuf) : scm_mk_real(dbuf);
}
static Expr* num_eq(Expr* args) {
assert(args);
if(args == EMPTY_LIST) return TRUE;
Expr* cur = scm_car(args);
checknum(cur);
bool eq = true;
bool exact = scm_is_int(cur);
long long ex;
double in;
if(exact) {
ex = scm_ival(cur);
in = ex;
} else {
in = scm_rval(cur);
ex = in;
exact = ((double)ex) == in;
}
args = scm_cdr(args);
while(scm_is_pair(args)) {
cur = scm_car(args);
checknum(cur);
if(exact && scm_is_int(cur)) {
if(ex != scm_ival(cur)) {
eq = false;
break;
}
} else if(exact) {
if(in != scm_rval(cur)) {
eq = false;
break;
}
} else if(scm_is_real(cur)) {
if(in != scm_rval(cur)) {
eq = false;
break;
}
} else {
eq = false;
break;
}
args = scm_cdr(args);
}
if(eq && args != EMPTY_LIST) return scm_mk_error("arguments to = aren't a proper list");
return eq ? TRUE : FALSE;
}
static Expr* real(Expr* args) {
assert(args);
if(args == EMPTY_LIST) return scm_mk_error("No args passed to real? (expected 1)");
Expr* fst = scm_car(args);
Expr* rst = scm_cdr(args);
if(rst != EMPTY_LIST) return scm_mk_error("Too many args passed to real? (expected 1)");
return scm_is_real(fst) ? TRUE : FALSE;
}
static Expr* inexact(Expr* args) {
assert(args);
if(args == EMPTY_LIST) return scm_mk_error("No args passed to inexact? (expected 1)");
Expr* fst = scm_car(args);
Expr* rst = scm_cdr(args);
if(rst != EMPTY_LIST) return scm_mk_error("Too many args passed to inexact? (expected 1)");
if(number(args) != TRUE) return scm_mk_error("Argument to inexact? is not a number");
return scm_is_real(fst) ? TRUE : FALSE;
}
static Expr* ex2in(Expr* args) {
assert(args);
if(scm_list_len(args) != 1) return scm_mk_error("exact->inexact expects 1 arg");
Expr* fst = scm_car(args);
if(scm_is_int(fst)) {
Expr* toRet = scm_mk_real(scm_ival(fst));
return toRet ? toRet : OOM;
} else if(scm_is_real(fst)) {
return fst;
} else {
return scm_mk_error("exact->inexact expects a number");
}
}
PyObject *scm2py(SCM value)
{
if (value == NULL)
return NULL;
if (value == SCM_UNSPECIFIED) {
Py_INCREF(Py_None);
return Py_None;
}
if (scm_is_exact_integer(value))
return PyInt_FromLong(scm_to_long(value));
if (scm_is_real(value))
return PyFloat_FromDouble(scm_to_double(value));
if (scm_is_bool(value)) {
PyObject *result = scm_to_bool(value) ? Py_True : Py_False;
Py_INCREF(result);
return result;
}
if (value == SCM_EOL)
return PyTuple_New(0);
if (scm_is_string(value)) {
size_t len = 0;
char *s = scm_to_utf8_stringn(value, &len);
PyObject *result = PyUnicode_FromStringAndSize(s, len);
free(s);
return result;
}
if (scm_is_pair(value)) {
unsigned int len = scm_to_uint(scm_length(value));
PyObject *result = PyTuple_New(len);
scm_dynwind_begin(0);
scm_dynwind_unwind_handler(
(void (*)(void *))Py_DecRef, result, 0);
unsigned int i;
for (i = 0; i < len; i++) {
PyObject *item = scm2py(scm_car(value));
if (item == NULL) {
scm_dynwind_end();
Py_DECREF(result);
return NULL;
}
PyTuple_SET_ITEM(result, i, item);
value = scm_cdr(value);
}
scm_dynwind_end();
return result;
}
if (scm_to_bool(scm_procedure_p(value))) {
SCM ptr = scm_assq_ref(gsubr_alist, value);
if (!scm_is_false(ptr)) {
PyObject *result = scm_to_pointer(ptr);
Py_INCREF(result);
return result;
}
Procedure *result =
(Procedure *)ProcedureType.tp_alloc(&ProcedureType, 0);
if (result == NULL)
return NULL;
result->proc = value;
return (PyObject *)result;
}
char *msg = scm_to_utf8_stringn(
scm_simple_format(
SCM_BOOL_F,
scm_from_utf8_string(
"Guile expression ~S doesn't have a "
"corresponding Python value"),
scm_list_1(value)), NULL);
PyErr_SetString(PyExc_TypeError, msg);
free(msg);
return NULL;
}
