fltype_t *get_type(value_t t)
{
fltype_t *ft;
if (issymbol(t)) {
ft = ((symbol_t*)ptr(t))->type;
if (ft != NULL)
return ft;
}
void **bp = equalhash_bp(&TypeTable, (void*)t);
if (*bp != HT_NOTFOUND)
return *bp;
int align, isarray=(iscons(t) && car_(t) == arraysym && iscons(cdr_(t)));
size_t sz;
if (isarray && !iscons(cdr_(cdr_(t)))) {
// special case: incomplete array type
sz = 0;
}
else {
sz = ctype_sizeof(t, &align);
}
ft = (fltype_t*)malloc(sizeof(fltype_t));
ft->type = t;
if (issymbol(t)) {
ft->numtype = sym_to_numtype(t);
((symbol_t*)ptr(t))->type = ft;
}
else {
ft->numtype = N_NUMTYPES;
}
ft->size = sz;
ft->vtable = NULL;
ft->artype = NULL;
ft->marked = 1;
ft->elsz = 0;
ft->eltype = NULL;
ft->init = NULL;
if (iscons(t)) {
if (isarray) {
fltype_t *eltype = get_type(car_(cdr_(t)));
if (eltype->size == 0) {
free(ft);
lerror(ArgError, "invalid array element type");
}
ft->elsz = eltype->size;
ft->eltype = eltype;
ft->init = &cvalue_array_init;
eltype->artype = ft;
}
}
*bp = ft;
return ft;
}
static void getFloat( ss_block *ss_new, char *start, int skip, int command )
{
char *text = start + skip;
ss_new->type = SE_FLOAT;
switch( command ) {
case AFTER_DOT:
if( !isdigit( *text ) ) {
if( *text == 'E' || *text == 'D' ) {
getFloat( ss_new, start, text - start + 1, AFTER_EXP );
return;
}
if( *text && !isspace( *text ) && !issymbol( *text ) ) {
if( *text ) {
text++;
}
ss_new->type = SE_INVALIDTEXT;
}
break;
}
text++;
while( isdigit( *text ) ) {
text++;
}
if( *text != 'E' && *text != 'D' ) {
break;
}
text++;
// fall through
case AFTER_EXP:
if( *text == '+' || *text == '-' ) {
text++;
}
if( !isdigit( *text ) ) {
if( *text ) {
text++;
}
ss_new->type = SE_INVALIDTEXT;
break;
}
text++;
while( isdigit( *text ) ) {
text++;
}
if( *text && !isspace( *text ) && !issymbol( *text ) ) {
ss_new->type = SE_INVALIDTEXT;
text++;
}
}
ss_new->len = text - start;
}
static int lengthestimate(value_t v)
{
// get the width of an expression if we can do so cheaply
if (issymbol(v))
return u8_strwidth(symbol_name(v));
return -1;
}
void eval() {
cont = continuation(cont_end, NIL);
C(cont)->expand = YES;
eval:
if (C(cont)->expand)
cont = continuation(cont_macroexpand, continuation(cont_eval, cont));
else if (iscons(expr))
cont = continuation(cont_list, cont);
else if (issymbol(expr))
cont = continuation(cont_symbol, cont);
apply_cont:
assert(iscontinuation(cont));
switch(C(cont)->fn()) {
case ACTION_EVAL:
goto eval;
case ACTION_APPLY_CONT:
goto apply_cont;
case ACTION_DONE:
break;
default:
abort();
}
/* By the time we get here, we should have finished the entire
computation, so should no longer have a continuation.*/
assert(isnil(cont));
}
static bool list_begins_with(object_t *list, object_t *search) {
if(ispair(list)) {
object_t *pair_car = car(list);
return issymbol(pair_car) && (pair_car == search);
}
return false;
}
void
yyhermite(void)
{
int n;
N = pop();
X = pop();
push(N);
n = pop_integer();
if (n < 0) {
push_symbol(HERMITE);
push(X);
push(N);
list(3);
return;
}
if (issymbol(X))
yyhermite2(n);
else {
Y = X; // do this when X is an expr
X = symbol(SECRETX);
yyhermite2(n);
X = Y;
push(symbol(SECRETX));
push(X);
subst();
eval();
}
}
void
factorpoly(void)
{
save();
p2 = pop();
p1 = pop();
if (!find(p1, p2)) {
push(p1);
restore();
return;
}
if (!ispoly(p1, p2)) {
push(p1);
restore();
return;
}
if (!issymbol(p2)) {
push(p1);
restore();
return;
}
push(p1);
push(p2);
yyfactorpoly();
restore();
}
int get_custom_key_handler_state() {
U* tmp = usr_symbol("prizmUIhandleKeys");
if (!issymbol(tmp)) return 0;
tmp = get_binding(tmp);
if(isnonnegativeinteger(tmp)) {
return !iszero(tmp);
} else return 0;
}
static inline int tinyp(value_t v)
{
if (issymbol(v))
return (u8_strwidth(symbol_name(v)) < SMALL_STR_LEN);
if (fl_isstring(v))
return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
return (isfixnum(v) || isbuiltin(v) || v==FL_F || v==FL_T || v==FL_NIL ||
v == FL_EOF);
}
static inline int tinyp(fl_context_t *fl_ctx, value_t v)
{
if (issymbol(v))
return (u8_strwidth(symbol_name(fl_ctx, v)) < SMALL_STR_LEN);
if (fl_isstring(fl_ctx, v))
return (cv_len((cvalue_t*)ptr(v)) < SMALL_STR_LEN);
return (isfixnum(v) || isbuiltin(v) || v==fl_ctx->F || v==fl_ctx->T || v==fl_ctx->NIL ||
v == fl_ctx->FL_EOF);
}
/* check whether arg is a symbol that consists solely of underscores. */
value_t fl_julia_underscore_symbolp(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
argcount(fl_ctx, "underscore-symbol?", nargs, 1);
if (!issymbol(args[0])) return fl_ctx->F;
char *op = symbol_name(fl_ctx, args[0]);
if (*op == '\0') return fl_ctx->F; // return false for empty symbol
while (*op == '_') ++op;
return *op ? fl_ctx->F : fl_ctx->T;
}
object_t primitive_eq(object_t argl) {
object_t a1 = car(argl);
object_t a2 = car(cdr(argl));
int result;
if(issymbol(a1) && issymbol(a2))
result = obj_symbol_cmp(a1, a2);
else if(isnum(a1) && isnum(a2))
result = (obj_get_number(a1) == obj_get_number(a2));
else
result = 0;
if(result)
return obj_new_symbol("#t");
else
return obj_new_symbol("#f");
}
static int same_token(int a, int b)
{
if (isname(a) && isname(b))
return 1;
if (isname(a) && isdigit(b))
return 1;
if (isdigit(a) && isdigit(b))
return 1;
if (issymbol(a) && issymbol(b) && a != '(' && a != ')' && b != '(' && b != ')')
return 1;
if (a == '-' && isdigit(b))
return 1;
return 0;
}
ref_t lookup(ref_t symbol) {
assert(issymbol(symbol));
ref_t binding, closure = C(cont)->closure;
while (!isnil(closure)) {
binding = car(closure);
if (car(binding) == symbol)
return cdr(binding);
closure = cdr(closure);
}
return get_value(symbol);
}
static jl_sym_t *scmsym_to_julia(value_t s)
{
assert(issymbol(s));
if (fl_isgensym(s)) {
static char gsname[16];
char *n = uint2str(&gsname[1], sizeof(gsname)-1,
((gensym_t*)ptr(s))->id, 10);
*(--n) = '#';
return jl_symbol(n);
}
return jl_symbol(symbol_name(s));
}
static value_t fl_constantp(value_t *args, u_int32_t nargs)
{
argcount("constant?", nargs, 1);
if (issymbol(args[0]))
return (isconstant((symbol_t*)ptr(args[0])) ? FL_T : FL_F);
if (iscons(args[0])) {
if (car_(args[0]) == QUOTE)
return FL_T;
return FL_F;
}
return FL_T;
}
/*****************************************************************************
check syntax patterns.
*****************************************************************************/
bool syntax_pattern (NormPtr p, Token first, ...)
{
va_list ap;
va_start (ap, first);
for (;first != -1; first = va_arg (ap, Token))
switch (first) {
default: if (CODE [p++] != first) return 0;
ncase VERIFY_symbol: if (!issymbol (CODE [p++])) return 0;
ncase VERIFY_string: if (!isvalue (CODE [p++])) return 0;
}
va_end (ap);
return 1;
}
value_t fl_julia_logmsg(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
int kwargs_len = (int)nargs - 6;
if (nargs < 6 || kwargs_len % 2 != 0) {
lerror(fl_ctx, fl_ctx->ArgError, "julia-logmsg: bad argument list - expected "
"level (symbol) group (symbol) id file line msg . kwargs");
}
value_t arg_level = args[0];
value_t arg_group = args[1];
value_t arg_id = args[2];
value_t arg_file = args[3];
value_t arg_line = args[4];
value_t arg_msg = args[5];
value_t *arg_kwargs = args + 6;
if (!isfixnum(arg_level) || !issymbol(arg_group) || !issymbol(arg_id) ||
!issymbol(arg_file) || !isfixnum(arg_line) || !fl_isstring(fl_ctx, arg_msg)) {
lerror(fl_ctx, fl_ctx->ArgError,
"julia-logmsg: Unexpected type in argument list");
}
// Abuse scm_to_julia here to convert arguments. This is meant for `Expr`s
// but should be good enough provided we're only passing simple numbers,
// symbols and strings.
jl_value_t *group=NULL, *id=NULL, *file=NULL, *line=NULL, *msg=NULL;
jl_array_t *kwargs=NULL;
JL_GC_PUSH6(&group, &id, &file, &line, &msg, &kwargs);
group = scm_to_julia(fl_ctx, arg_group, NULL);
id = scm_to_julia(fl_ctx, arg_id, NULL);
file = scm_to_julia(fl_ctx, arg_file, NULL);
line = scm_to_julia(fl_ctx, arg_line, NULL);
msg = scm_to_julia(fl_ctx, arg_msg, NULL);
kwargs = jl_alloc_vec_any(kwargs_len);
for (int i = 0; i < kwargs_len; ++i) {
jl_array_ptr_set(kwargs, i, scm_to_julia(fl_ctx, arg_kwargs[i], NULL));
}
jl_log(numval(arg_level), NULL, group, id, file, line, (jl_value_t*)kwargs, msg);
JL_GC_POP();
return fl_ctx->T;
}
void print_traverse(value_t v)
{
value_t *bp;
while (iscons(v)) {
if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++);
return;
}
mark_cons(v);
print_traverse(car_(v));
v = cdr_(v);
}
if (!ismanaged(v) || issymbol(v))
return;
if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++);
return;
}
if (isvector(v)) {
if (vector_size(v) > 0)
mark_cons(v);
unsigned int i;
for(i=0; i < vector_size(v); i++)
print_traverse(vector_elt(v,i));
}
else if (iscprim(v)) {
mark_cons(v);
}
else if (isclosure(v)) {
mark_cons(v);
function_t *f = (function_t*)ptr(v);
print_traverse(f->bcode);
print_traverse(f->vals);
print_traverse(f->env);
}
else {
assert(iscvalue(v));
cvalue_t *cv = (cvalue_t*)ptr(v);
// don't consider shared references to ""
if (!cv_isstr(cv) || cv_len(cv)!=0)
mark_cons(v);
fltype_t *t = cv_class(cv);
if (t->vtable != NULL && t->vtable->print_traverse != NULL)
t->vtable->print_traverse(v);
}
}
void
eval_product(void)
{
int i, j, k;
// 1st arg (quoted)
X = cadr(p1);
if (!issymbol(X))
stop("product: 1st arg?");
// 2nd arg
push(caddr(p1));
eval();
j = pop_integer();
if (j == (int) 0x80000000)
stop("product: 2nd arg?");
// 3rd arg
push(cadddr(p1));
eval();
k = pop_integer();
if (k == (int) 0x80000000)
stop("product: 3rd arg?");
// 4th arg
// fix
p1 = cddddr(p1);
p1 = car(p1);
B = get_binding(X);
A = get_arglist(X);
push_integer(1);
for (i = j; i <= k; i++) {
push_integer(i);
I = pop();
set_binding(X, I);
push(p1);
eval();
multiply();
}
set_binding_and_arglist(X, B, A);
}
int get_custom_fkey_label(int fkey) {
U* tmp;
if(fkey==2) {
tmp = usr_symbol("prizmUIfkey3label");
} else if (fkey==3) {
tmp = usr_symbol("prizmUIfkey4label");
} else if (fkey==5) {
tmp = usr_symbol("prizmUIfkey6label");
} else return 0;
if (issymbol(tmp)) {
tmp = get_binding(tmp);
if(isnonnegativeinteger(tmp)) {
return *tmp->u.q.a;
}
}
return 0;
}
void
setup_yrange_f(void)
{
// default range is (-10,10)
ymin = -10.0;
ymax = 10.0;
p1 = usr_symbol("yrange");
if (!issymbol(p1))
return;
p1 = get_binding(p1);
// must be two element vector
if (!istensor(p1) || p1->u.tensor->ndim != 1 || p1->u.tensor->nelem != 2)
return;
push(p1->u.tensor->elem[0]);
eval();
yyfloat();
eval();
p2 = pop();
push(p1->u.tensor->elem[1]);
eval();
yyfloat();
eval();
p3 = pop();
if (!isnum(p2) || !isnum(p3))
return;
push(p2);
ymin = pop_double();
push(p3);
ymax = pop_double();
if (ymin == ymax)
stop("draw: yrange is zero");
}
void
setup_trange_f(void)
{
// default range is (-pi, pi)
tmin = -M_PI;
tmax = M_PI;
p1 = usr_symbol("trange");
if (!issymbol(p1))
return;
p1 = get_binding(p1);
// must be two element vector
if (!istensor(p1) || p1->u.tensor->ndim != 1 || p1->u.tensor->nelem != 2)
return;
push(p1->u.tensor->elem[0]);
eval();
yyfloat();
eval();
p2 = pop();
push(p1->u.tensor->elem[1]);
eval();
yyfloat();
eval();
p3 = pop();
if (!isnum(p2) || !isnum(p3))
return;
push(p2);
tmin = pop_double();
push(p3);
tmax = pop_double();
if (tmin == tmax)
stop("draw: trange is zero");
}
void
d_scalar_scalar(void)
{
if (issymbol(p2))
d_scalar_scalar_1();
else {
// Example: d(sin(cos(x)),cos(x))
// Replace cos(x) <- X, find derivative, then do X <- cos(x)
push(p1); // sin(cos(x))
push(p2); // cos(x)
push(symbol(SECRETX)); // X
subst(); // sin(cos(x)) -> sin(X)
push(symbol(SECRETX)); // X
derivative();
push(symbol(SECRETX)); // X
push(p2); // cos(x)
subst(); // cos(X) -> cos(cos(x))
}
}
value_t fl_julia_strip_op_suffix(fl_context_t *fl_ctx, value_t *args, uint32_t nargs)
{
argcount(fl_ctx, "strip-op-suffix", nargs, 1);
if (!issymbol(args[0]))
type_error(fl_ctx, "strip-op-suffix", "symbol", args[0]);
char *op = symbol_name(fl_ctx, args[0]);
size_t i = 0;
while (op[i]) {
size_t j = i;
if (jl_op_suffix_char(u8_nextchar(op, &j)))
break;
i = j;
}
if (!op[i]) return args[0]; // no suffix to strip
if (!i) return args[0]; // only suffix chars --- might still be a valid identifier
char *opnew = strncpy((char*)malloc(i+1), op, i);
opnew[i] = 0;
value_t opnew_symbol = symbol(fl_ctx, opnew);
free(opnew);
return opnew_symbol;
}
//defines a new macro, adds it to the macro list
void new_macro(char *symbol, char *line, char *operand)
{
extern int source_line_num;
struct sym *sym;
if (macro_ctn >= MAX_DEF_MACRO)
as_exit("Parse Error: Too many macros");
if(isalpha(*symbol)==0)
as_exit("Parse Error: Symbol must start with an alpha character");
if(ismacro(symbol)!=-1)
as_exit("Parsed Error: macro is already defined");
if(issymbol(symbol,&sym)!=-1)
as_exit("Parse Error: Symbol is already defined");
macro[macro_ctn].line_num=source_line_num;
macro[macro_ctn].ptr=line;
strcpy(macro[macro_ctn].name,symbol);
macro[macro_ctn].operands=operand;
macro_ctn++;
}
object_t primitive_symbolp(object_t argl) {
if(issymbol(car(argl)))
return obj_new_symbol("#t");
else
return obj_new_symbol("#f");
}
static value_t fl_keywordp(value_t *args, u_int32_t nargs)
{
argcount("keyword?", nargs, 1);
return (issymbol(args[0]) &&
iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
}
// label is the backreference we'd like to fix up with this read
static value_t do_read_sexpr(value_t label)
{
value_t v, sym, oldtokval, *head;
value_t *pv;
u_int32_t t;
char c;
t = peek();
take();
switch (t) {
case TOK_CLOSE:
lerror(ParseError, "read: unexpected ')'");
case TOK_CLOSEB:
lerror(ParseError, "read: unexpected ']'");
case TOK_DOT:
lerror(ParseError, "read: unexpected '.'");
case TOK_SYM:
case TOK_NUM:
return tokval;
case TOK_COMMA:
head = &COMMA; goto listwith;
case TOK_COMMAAT:
head = &COMMAAT; goto listwith;
case TOK_COMMADOT:
head = &COMMADOT; goto listwith;
case TOK_BQ:
head = &BACKQUOTE; goto listwith;
case TOK_QUOTE:
head = "E;
listwith:
v = cons_reserve(2);
car_(v) = *head;
cdr_(v) = tagptr(((cons_t*)ptr(v))+1, TAG_CONS);
car_(cdr_(v)) = cdr_(cdr_(v)) = NIL;
PUSH(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
v = do_read_sexpr(UNBOUND);
car_(cdr_(Stack[SP-1])) = v;
return POP();
case TOK_SHARPQUOTE:
// femtoLisp doesn't need symbol-function, so #' does nothing
return do_read_sexpr(label);
case TOK_OPEN:
PUSH(NIL);
read_list(&Stack[SP-1], label);
return POP();
case TOK_SHARPSYM:
sym = tokval;
if (sym == tsym || sym == Tsym)
return FL_T;
else if (sym == fsym || sym == Fsym)
return FL_F;
// constructor notation
c = nextchar();
if (c != '(') {
take();
lerrorf(ParseError, "read: expected argument list for %s",
symbol_name(tokval));
}
PUSH(NIL);
read_list(&Stack[SP-1], UNBOUND);
if (sym == vu8sym) {
sym = arraysym;
Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
}
else if (sym == fnsym) {
sym = FUNCTION;
}
v = symbol_value(sym);
if (v == UNBOUND)
fl_raise(fl_list2(UnboundError, sym));
return fl_apply(v, POP());
case TOK_OPENB:
return read_vector(label, TOK_CLOSEB);
case TOK_SHARPOPEN:
return read_vector(label, TOK_CLOSE);
case TOK_SHARPDOT:
// eval-when-read
// evaluated expressions can refer to existing backreferences, but they
// cannot see pending labels. in other words:
// (... #2=#.#0# ... ) OK
// (... #2=#.(#2#) ... ) DO NOT WANT
sym = do_read_sexpr(UNBOUND);
if (issymbol(sym)) {
v = symbol_value(sym);
if (v == UNBOUND)
fl_raise(fl_list2(UnboundError, sym));
return v;
}
return fl_toplevel_eval(sym);
case TOK_LABEL:
// create backreference label
if (ptrhash_has(&readstate->backrefs, (void*)tokval))
lerrorf(ParseError, "read: label %ld redefined", numval(tokval));
oldtokval = tokval;
v = do_read_sexpr(tokval);
ptrhash_put(&readstate->backrefs, (void*)oldtokval, (void*)v);
return v;
case TOK_BACKREF:
// look up backreference
v = (value_t)ptrhash_get(&readstate->backrefs, (void*)tokval);
if (v == (value_t)HT_NOTFOUND)
lerrorf(ParseError, "read: undefined label %ld", numval(tokval));
return v;
case TOK_GENSYM:
pv = (value_t*)ptrhash_bp(&readstate->gensyms, (void*)tokval);
if (*pv == (value_t)HT_NOTFOUND)
*pv = fl_gensym(NULL, 0);
return *pv;
case TOK_DOUBLEQUOTE:
return read_string();
}
return FL_UNSPECIFIED;
}
static jl_value_t *scm_to_julia_(value_t e)
{
if (fl_isnumber(e)) {
if (iscprim(e)) {
numerictype_t nt = cp_numtype((cprim_t*)ptr(e));
switch (nt) {
case T_DOUBLE:
return (jl_value_t*)jl_box_float64(*(double*)cp_data((cprim_t*)ptr(e)));
case T_FLOAT:
return (jl_value_t*)jl_box_float32(*(float*)cp_data((cprim_t*)ptr(e)));
case T_INT64:
return (jl_value_t*)jl_box_int64(*(int64_t*)cp_data((cprim_t*)ptr(e)));
case T_UINT8:
return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data((cprim_t*)ptr(e)));
case T_UINT16:
return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data((cprim_t*)ptr(e)));
case T_UINT32:
return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data((cprim_t*)ptr(e)));
case T_UINT64:
return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data((cprim_t*)ptr(e)));
default:
;
}
}
if (isfixnum(e)) {
int64_t ne = numval(e);
#ifdef __LP64__
return (jl_value_t*)jl_box_int64(ne);
#else
if (ne > S32_MAX || ne < S32_MIN)
return (jl_value_t*)jl_box_int64(ne);
return (jl_value_t*)jl_box_int32((int32_t)ne);
#endif
}
uint64_t n = toulong(e, "scm_to_julia");
#ifdef __LP64__
return (jl_value_t*)jl_box_int64((int64_t)n);
#else
if (n > S32_MAX)
return (jl_value_t*)jl_box_int64((int64_t)n);
return (jl_value_t*)jl_box_int32((int32_t)n);
#endif
}
if (issymbol(e)) {
if (!fl_isgensym(e)) {
char *sn = symbol_name(e);
if (!strcmp(sn, "true"))
return jl_true;
else if (!strcmp(sn, "false"))
return jl_false;
}
return (jl_value_t*)scmsym_to_julia(e);
}
if (fl_isstring(e)) {
return jl_pchar_to_string(cvalue_data(e), cvalue_len(e));
}
if (e == FL_F) {
return jl_false;
}
if (e == FL_T) {
return jl_true;
}
if (e == FL_NIL) {
return (jl_value_t*)jl_null;
}
if (iscons(e)) {
value_t hd = car_(e);
if (issymbol(hd)) {
jl_sym_t *sym = scmsym_to_julia(hd);
/* tree node types:
goto gotoifnot label return
lambda call = quote
null top method
body file new
line enter leave
*/
size_t n = llength(e)-1;
size_t i;
if (sym == lambda_sym) {
jl_expr_t *ex = jl_exprn(lambda_sym, n);
e = cdr_(e);
value_t largs = car_(e);
jl_cellset(ex->args, 0, full_list(largs));
e = cdr_(e);
value_t ee = car_(e);
jl_array_t *vinf = jl_alloc_cell_1d(3);
jl_cellset(vinf, 0, full_list(car_(ee)));
ee = cdr_(ee);
jl_cellset(vinf, 1, full_list_of_lists(car_(ee)));
ee = cdr_(ee);
jl_cellset(vinf, 2, full_list_of_lists(car_(ee)));
assert(!iscons(cdr_(ee)));
jl_cellset(ex->args, 1, vinf);
e = cdr_(e);
for(i=2; i < n; i++) {
assert(iscons(e));
jl_cellset(ex->args, i, scm_to_julia_(car_(e)));
e = cdr_(e);
}
return
(jl_value_t*)jl_new_lambda_info((jl_value_t*)ex, jl_null);
}
e = cdr_(e);
if (sym == line_sym && n==1) {
return jl_new_struct(jl_linenumbernode_type,
scm_to_julia_(car_(e)));
}
if (sym == label_sym) {
return jl_new_struct(jl_labelnode_type,
scm_to_julia_(car_(e)));
}
if (sym == goto_sym) {
return jl_new_struct(jl_gotonode_type,
scm_to_julia_(car_(e)));
}
if (sym == quote_sym) {
return jl_new_struct(jl_quotenode_type,
scm_to_julia_(car_(e)));
}
if (sym == top_sym) {
return jl_new_struct(jl_topnode_type,
scm_to_julia_(car_(e)));
}
jl_expr_t *ex = jl_exprn(sym, n);
for(i=0; i < n; i++) {
assert(iscons(e));
jl_cellset(ex->args, i, scm_to_julia_(car_(e)));
e = cdr_(e);
}
return (jl_value_t*)ex;
}
else {
jl_error("malformed tree");
}
}
if (iscprim(e) && cp_class((cprim_t*)ptr(e))==wchartype) {
jl_value_t *wc =
jl_box32(jl_char_type, *(int32_t*)cp_data((cprim_t*)ptr(e)));
return wc;
}
if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jvtype) {
return *(jl_value_t**)cv_data((cvalue_t*)ptr(e));
}
jl_error("malformed tree");
return (jl_value_t*)jl_null;
}