// load toplevel expressions, from (file ...)
void jl_load_file_expr(char *fname, jl_value_t *ast)
{
jl_array_t *b = ((jl_expr_t*)ast)->args;
size_t i;
volatile size_t lineno=0;
if (((jl_expr_t*)ast)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(ast,0)));
}
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
if (((jl_expr_t*)ast)->head == error_sym) {
jl_interpret_toplevel_expr(ast);
}
for(i=0; i < b->length; i++) {
// process toplevel form
jl_value_t *form = jl_cellref(b, i);
if (jl_is_linenode(form)) {
lineno = jl_linenode_line(form);
}
else {
(void)jl_toplevel_eval_flex(form, 0, &lineno);
}
}
}
JL_CATCH {
jl_value_t *fn=NULL, *ln=NULL;
JL_GC_PUSH(&fn, &ln);
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
}
JL_DLLEXPORT jl_value_t *jl_array_to_string(jl_array_t *a)
{
size_t len = jl_array_len(a);
if (a->flags.how == 3 && a->offset == 0 && a->elsize == 1 &&
(jl_array_ndims(a) != 1 ||
((a->maxsize + sizeof(void*) + 1 <= GC_MAX_SZCLASS) == (len + sizeof(void*) + 1 <= GC_MAX_SZCLASS)))) {
jl_value_t *o = jl_array_data_owner(a);
if (jl_is_string(o)) {
a->flags.isshared = 1;
*(size_t*)o = len;
a->nrows = 0;
#ifdef STORE_ARRAY_LEN
a->length = 0;
#endif
a->maxsize = 0;
return o;
}
}
a->nrows = 0;
#ifdef STORE_ARRAY_LEN
a->length = 0;
#endif
a->maxsize = 0;
return jl_pchar_to_string((const char*)jl_array_data(a), len);
}
// repeatedly call jl_parse_next and eval everything
void jl_parse_eval_all(char *fname)
{
//ios_printf(ios_stderr, "***** loading %s\n", fname);
int lineno=0;
jl_value_t *fn=NULL, *ln=NULL, *form=NULL;
JL_GC_PUSH(&fn, &ln, &form);
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
while (1) {
form = jl_parse_next(&lineno);
if (form == NULL)
break;
if (jl_is_expr(form)) {
if (((jl_expr_t*)form)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(form,0)));
}
if (((jl_expr_t*)form)->head == error_sym) {
jl_interpret_toplevel_expr(form);
}
}
(void)jl_toplevel_eval_flex(form, 1, &lineno);
}
}
JL_CATCH {
jl_stop_parsing();
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
jl_stop_parsing();
JL_GC_POP();
}
static jl_value_t *from_td_val(td_val_t *v)
{
td_tag_t tag = td_typeof(v);
switch (tag) {
case TD_INT8:
return jl_box_int8(td_int8(v));
case TD_UINT8:
return jl_box_uint8(td_uint8(v));
case TD_INT16:
return jl_box_int16(td_int16(v));
case TD_UINT16:
return jl_box_uint16(td_uint16(v));
case TD_INT32:
return jl_box_int32(td_int32(v));
case TD_UINT32:
return jl_box_uint32(td_uint32(v));
case TD_INT64:
return jl_box_int64(td_int64(v));
case TD_UINT64:
return jl_box_uint64(td_uint64(v));
case TD_FLOAT:
return jl_box_float32(td_float(v));
case TD_DOUBLE:
return jl_box_float64(td_double(v));
case TD_UTF8:
return jl_pchar_to_string(td_dataptr(v), td_length(v));
case TD_ARRAY:
return (jl_value_t*)
jl_ptr_to_array_1d((jl_value_t*)jl_apply_array_type((jl_datatype_t*)td_type_to_jl(td_eltype(v)), 1),
td_dataptr(v), td_length(v), 0);
default:
return jl_nothing;
}
}
jl_value_t *jl_environ(int i)
{
#ifdef __APPLE__
char **environ = *_NSGetEnviron();
#endif
char *env = environ[i];
return env ? jl_pchar_to_string(env, strlen(env)) : jl_nothing;
}
// with function name / location description, plus extra context
JL_DLLEXPORT void JL_NORETURN jl_type_error_rt(const char *fname, const char *context,
jl_value_t *expected, jl_value_t *got)
{
jl_value_t *ctxt=NULL;
JL_GC_PUSH2(&ctxt, &got);
ctxt = jl_pchar_to_string((char*)context, strlen(context));
jl_value_t *ex = jl_new_struct(jl_typeerror_type, jl_symbol(fname), ctxt, expected, got);
jl_throw(ex);
}
JL_DLLEXPORT void JL_NORETURN jl_error(const char *str)
{
if (jl_errorexception_type == NULL) {
jl_printf(JL_STDERR, "ERROR: %s\n", str);
jl_exit(1);
}
jl_value_t *msg = jl_pchar_to_string((char*)str, strlen(str));
JL_GC_PUSH1(&msg);
jl_throw(jl_new_struct(jl_errorexception_type, msg));
}
void jl_error(const char *str)
{
if (jl_errorexception_type == NULL) {
JL_PRINTF(JL_STDERR, "%s", str);
jl_exit(1);
}
jl_value_t *msg = jl_pchar_to_string((char*)str, strlen(str));
JL_GC_PUSH(&msg);
jl_raise(jl_new_struct(jl_errorexception_type, msg));
}
void jl_type_error_rt(const char *fname, const char *context,
jl_value_t *ty, jl_value_t *got)
{
jl_value_t *ctxt=NULL;
JL_GC_PUSH(&ctxt, &got);
ctxt = jl_pchar_to_string((char*)context, strlen(context));
jl_value_t *ex = jl_new_struct(jl_typeerror_type, jl_symbol(fname),
ctxt, ty, got);
jl_raise(ex);
}
void jl_errorf(const char *fmt, ...)
{
char buf[1024];
va_list args;
va_start(args, fmt);
int nc = vsnprintf(buf, sizeof(buf), fmt, args);
va_end(args);
jl_value_t *msg = jl_pchar_to_string(buf, nc);
JL_GC_PUSH(&msg);
jl_raise(jl_new_struct(jl_errorexception_type, msg));
}
static jl_value_t* call_jl_function_with_string(const char *fname, const char *arg, size_t arglen)
{
jl_value_t *f = jl_get_global(jl_base_module,jl_symbol(fname));
assert(f);
jl_value_t **fargs;
JL_GC_PUSHARGS(fargs, 1);
fargs[0] = jl_pchar_to_string((char*)arg, arglen);
jl_value_t *result = jl_apply((jl_function_t*)f, fargs, 1);
JL_GC_POP();
return result;
}
JL_DLLEXPORT jl_value_t *jl_readuntil(ios_t *s, uint8_t delim, uint8_t str, uint8_t chomp)
{
jl_array_t *a;
// manually inlined common case
char *pd = (char*)memchr(s->buf + s->bpos, delim, (size_t)(s->size - s->bpos));
if (pd) {
size_t n = pd - (s->buf + s->bpos) + 1;
if (str) {
size_t nchomp = 0;
if (chomp) {
nchomp = ios_nchomp(s, n);
}
jl_value_t *str = jl_pchar_to_string(s->buf + s->bpos, n - nchomp);
s->bpos += n;
return str;
}
a = jl_alloc_array_1d(jl_array_uint8_type, n);
memcpy(jl_array_data(a), s->buf + s->bpos, n);
s->bpos += n;
}
else {
a = jl_alloc_array_1d(jl_array_uint8_type, 80);
ios_t dest;
ios_mem(&dest, 0);
ios_setbuf(&dest, (char*)a->data, 80, 0);
size_t n = ios_copyuntil(&dest, s, delim);
if (chomp && n > 0 && dest.buf[n - 1] == '\n') {
n--;
if (n > 0 && dest.buf[n - 1] == '\r') {
n--;
}
int truncret = ios_trunc(&dest, n); // it should always be possible to truncate dest
assert(truncret == 0);
(void)truncret; // ensure the variable is used to avoid warnings
}
if (dest.buf != a->data) {
a = jl_take_buffer(&dest);
}
else {
#ifdef STORE_ARRAY_LEN
a->length = n;
#endif
a->nrows = n;
((char*)a->data)[n] = '\0';
}
if (str) {
JL_GC_PUSH1(&a);
jl_value_t *st = jl_array_to_string(a);
JL_GC_POP();
return st;
}
}
return (jl_value_t*)a;
}
static jl_value_t* repl_parse_input_line(char *buf) {
if (buf[0] == ';') {
buf++;
jl_value_t *f = jl_get_global(jl_base_module,jl_symbol("repl_hook"));
assert(f);
jl_value_t **fargs;
JL_GC_PUSHARGS(fargs, 1);
fargs[0] = jl_pchar_to_string((char*)buf, strlen(buf));
jl_value_t *result = jl_apply((jl_function_t*)f, fargs, 1);
JL_GC_POP();
return result;
}
return jl_parse_input_line(buf);
}
void jl_errorf(const char *fmt, ...)
{
char buf[1024];
va_list args;
va_start(args, fmt);
int nc = vsnprintf(buf, sizeof(buf), fmt, args);
va_end(args);
if (jl_errorexception_type == NULL) {
JL_PRINTF(JL_STDERR, "%s", &buf);
jl_exit(1);
}
jl_value_t *msg = jl_pchar_to_string(buf, nc);
JL_GC_PUSH1(&msg);
jl_throw(jl_new_struct(jl_errorexception_type, msg));
}
// load toplevel expressions, from (file ...)
void jl_load_file_expr(char *fname, jl_value_t *ast)
{
jl_array_t *b = ((jl_expr_t*)ast)->args;
size_t i;
volatile size_t lineno=0;
if (((jl_expr_t*)ast)->head == jl_continue_sym) {
jl_errorf("syntax error: %s", jl_string_data(jl_exprarg(ast,0)));
}
char oldcwd[512];
char newcwd[512];
get_cwd(oldcwd, sizeof(oldcwd));
char *sep = strrchr(fname, PATHSEP);
if (sep) {
size_t n = (sep - fname)+1;
if (n > sizeof(newcwd)-1) n = sizeof(newcwd)-1;
strncpy(newcwd, fname, n);
newcwd[n] = '\0';
set_cwd(newcwd);
}
JL_TRY {
jl_register_toplevel_eh();
// handle syntax error
if (((jl_expr_t*)ast)->head == error_sym) {
jl_interpret_toplevel_expr(ast);
}
for(i=0; i < b->length; i++) {
// process toplevel form
jl_value_t *form = jl_cellref(b, i);
if (jl_is_linenode(form)) {
lineno = jl_linenode_line(form);
}
else {
(void)jl_toplevel_eval_flex(form, 0, &lineno);
}
}
}
JL_CATCH {
if (sep) set_cwd(oldcwd);
jl_value_t *fn=NULL, *ln=NULL;
JL_GC_PUSH(&fn, &ln);
fn = jl_pchar_to_string(fname, strlen(fname));
ln = jl_box_long(lineno);
jl_raise(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
if (sep) set_cwd(oldcwd);
}
// repeatedly call jl_parse_next and eval everything
jl_value_t *jl_parse_eval_all(const char *fname, size_t len)
{
//jl_printf(JL_STDERR, "***** loading %s\n", fname);
int last_lineno = jl_lineno;
const char *last_filename = jl_filename;
jl_lineno = 0;
jl_filename = fname;
jl_value_t *fn=NULL, *ln=NULL, *form=NULL, *result=jl_nothing;
JL_GC_PUSH4(&fn, &ln, &form, &result);
JL_TRY {
// handle syntax error
while (1) {
form = jl_parse_next();
if (form == NULL)
break;
if (jl_is_expr(form)) {
if (((jl_expr_t*)form)->head == jl_incomplete_sym) {
jl_errorf("syntax: %s", jl_string_data(jl_exprarg(form,0)));
}
if (((jl_expr_t*)form)->head == error_sym) {
jl_interpret_toplevel_expr(form);
}
}
result = jl_toplevel_eval_flex(form, 1);
}
}
JL_CATCH {
jl_stop_parsing();
fn = jl_pchar_to_string(fname, len);
ln = jl_box_long(jl_lineno);
jl_lineno = last_lineno;
jl_filename = last_filename;
if (jl_loaderror_type == NULL) {
jl_rethrow();
}
else {
jl_rethrow_other(jl_new_struct(jl_loaderror_type, fn, ln,
jl_exception_in_transit));
}
}
jl_stop_parsing();
jl_lineno = last_lineno;
jl_filename = last_filename;
JL_GC_POP();
return result;
}
static jl_value_t *jl_vexceptionf(jl_datatype_t *exception_type,
const char *fmt, va_list args)
{
if (exception_type == NULL) {
jl_printf(JL_STDERR, "ERROR: ");
jl_vprintf(JL_STDERR, fmt, args);
jl_printf(JL_STDERR, "\n");
jl_exit(1);
}
char *str = NULL;
int ok = vasprintf(&str, fmt, args);
jl_value_t *msg;
if (ok < 0) { // vasprintf failed
msg = jl_cstr_to_string("internal error: could not display error message");
}
else {
msg = jl_pchar_to_string(str, strlen(str));
free(str);
}
JL_GC_PUSH1(&msg);
jl_value_t *e = jl_new_struct(exception_type, msg);
JL_GC_POP();
return e;
}
JL_DLLEXPORT jl_value_t *jl_cstr_to_string(const char *str)
{
return jl_pchar_to_string(str, strlen(str));
}
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;
}
static jl_value_t *scm_to_julia_(value_t e, int eo)
{
if (fl_isnumber(e)) {
int64_t i64;
if (isfixnum(e)) {
i64 = numval(e);
}
else {
assert(iscprim(e));
cprim_t *cp = (cprim_t*)ptr(e);
numerictype_t nt = cp_numtype(cp);
switch (nt) {
case T_DOUBLE:
return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp));
case T_FLOAT:
return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp));
case T_UINT8:
return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp));
case T_UINT16:
return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp));
case T_UINT32:
return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp));
case T_UINT64:
return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp));
default:
;
}
i64 = conv_to_int64(cp_data(cp), nt);
}
if (
#ifdef _P64
jl_compileropts.int_literals==32
#else
jl_compileropts.int_literals!=64
#endif
) {
if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN)
return (jl_value_t*)jl_box_int64(i64);
return (jl_value_t*)jl_box_int32((int32_t)i64);
}
else {
return (jl_value_t*)jl_box_int64(i64);
}
}
if (issymbol(e)) {
if (e == true_sym)
return jl_true;
else if (e == false_sym)
return jl_false;
return (jl_value_t*)scmsym_to_julia(e);
}
if (fl_isstring(e)) {
return jl_pchar_to_string((char*)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 == null_sym && n == 0)
return jl_nothing;
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,eo));
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),eo));
ee = cdr_(ee);
jl_cellset(vinf, 1, full_list_of_lists(car_(ee),eo));
ee = cdr_(ee);
jl_cellset(vinf, 2, full_list_of_lists(car_(ee),eo));
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), eo));
e = cdr_(e);
}
return
(jl_value_t*)jl_new_lambda_info((jl_value_t*)ex, jl_null);
}
e = cdr_(e);
if (!eo) {
if (sym == line_sym && n==1) {
return jl_new_struct(jl_linenumbernode_type,
scm_to_julia_(car_(e),0));
}
if (sym == label_sym) {
return jl_new_struct(jl_labelnode_type,
scm_to_julia_(car_(e),0));
}
if (sym == goto_sym) {
return jl_new_struct(jl_gotonode_type,
scm_to_julia_(car_(e),0));
}
if (sym == quote_sym) {
return jl_new_struct(jl_quotenode_type,
scm_to_julia_(car_(e),0));
}
if (sym == top_sym) {
return jl_new_struct(jl_topnode_type,
scm_to_julia_(car_(e),0));
}
if (sym == newvar_sym) {
return jl_new_struct(jl_newvarnode_type,
scm_to_julia_(car_(e),0));
}
}
jl_expr_t *ex = jl_exprn(sym, n);
// allocate a fresh args array for empty exprs passed to macros
if (eo && n == 0)
ex->args = jl_alloc_cell_1d(0);
for(i=0; i < n; i++) {
assert(iscons(e));
jl_cellset(ex->args, i, scm_to_julia_(car_(e),eo));
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;
}
jl_value_t *jl_cstr_to_string(char *str)
{
return jl_pchar_to_string(str, strlen(str));
}
jl_value_t *jl_strerror(int errnum)
{
char *str = strerror(errnum);
return jl_pchar_to_string((char*)str, strlen(str));
}
void jl_error(const char *str)
{
jl_value_t *msg = jl_pchar_to_string((char*)str, strlen(str));
JL_GC_PUSH(&msg);
jl_raise(jl_new_struct(jl_errorexception_type, msg));
}
// parse and eval a whole file, possibly reading from a string (`content`)
jl_value_t *jl_parse_eval_all(const char *fname,
const char *content, size_t contentlen)
{
if (in_pure_callback)
jl_error("cannot use include inside a generated function");
jl_ast_context_t *ctx = jl_ast_ctx_enter();
fl_context_t *fl_ctx = &ctx->fl;
value_t f, ast;
size_t len = strlen(fname);
f = cvalue_static_cstrn(fl_ctx, fname, len);
fl_gc_handle(fl_ctx, &f);
if (content != NULL) {
value_t t = cvalue_static_cstrn(fl_ctx, content, contentlen);
fl_gc_handle(fl_ctx, &t);
ast = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-string-stream")), t, f);
fl_free_gc_handles(fl_ctx, 1);
}
else {
assert(memchr(fname, 0, len) == NULL); // was checked already in jl_load
ast = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-parse-file")), f);
}
fl_free_gc_handles(fl_ctx, 1);
if (ast == fl_ctx->F) {
jl_ast_ctx_leave(ctx);
jl_errorf("could not open file %s", fname);
}
fl_gc_handle(fl_ctx, &ast);
int last_lineno = jl_lineno;
const char *last_filename = jl_filename;
jl_lineno = 0;
jl_filename = fname;
jl_array_t *roots = NULL;
jl_array_t **old_roots = ctx->roots;
ctx->roots = &roots;
jl_value_t *form=NULL, *result=jl_nothing;
int err = 0;
JL_GC_PUSH3(&roots, &form, &result);
JL_TRY {
assert(iscons(ast) && car_(ast) == symbol(fl_ctx,"toplevel"));
ast = cdr_(ast);
while (iscons(ast)) {
value_t expansion = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-expand-to-thunk")), car_(ast));
form = scm_to_julia(fl_ctx, expansion, 0);
jl_sym_t *head = NULL;
if (jl_is_expr(form)) head = ((jl_expr_t*)form)->head;
JL_SIGATOMIC_END();
if (head == jl_incomplete_sym)
jl_errorf("syntax: %s", jl_string_data(jl_exprarg(form,0)));
else if (head == error_sym)
jl_interpret_toplevel_expr(form);
else if (head == line_sym)
jl_lineno = jl_unbox_long(jl_exprarg(form,0));
else if (jl_is_linenode(form))
jl_lineno = jl_linenode_line(form);
else
result = jl_toplevel_eval_flex(form, 1, 1);
JL_SIGATOMIC_BEGIN();
ast = cdr_(ast);
}
}
JL_CATCH {
form = jl_pchar_to_string(fname, len);
result = jl_box_long(jl_lineno);
err = 1;
}
jl_lineno = last_lineno;
jl_filename = last_filename;
fl_free_gc_handles(fl_ctx, 1);
ctx->roots = old_roots;
jl_ast_ctx_leave(ctx);
if (err) {
if (jl_loaderror_type == NULL)
jl_rethrow();
else
jl_rethrow_other(jl_new_struct(jl_loaderror_type, form, result,
jl_exception_in_transit));
}
JL_GC_POP();
return result;
}
// parse and eval a whole file, possibly reading from a string (`content`)
jl_value_t *jl_parse_eval_all(const char *fname,
const char *content, size_t contentlen,
jl_module_t *inmodule)
{
jl_ptls_t ptls = jl_get_ptls_states();
if (ptls->in_pure_callback)
jl_error("cannot use include inside a generated function");
jl_ast_context_t *ctx = jl_ast_ctx_enter();
fl_context_t *fl_ctx = &ctx->fl;
value_t f, ast, expression;
size_t len = strlen(fname);
f = cvalue_static_cstrn(fl_ctx, fname, len);
fl_gc_handle(fl_ctx, &f);
if (content != NULL) {
JL_TIMING(PARSING);
value_t t = cvalue_static_cstrn(fl_ctx, content, contentlen);
fl_gc_handle(fl_ctx, &t);
ast = fl_applyn(fl_ctx, 2, symbol_value(symbol(fl_ctx, "jl-parse-string-stream")), t, f);
fl_free_gc_handles(fl_ctx, 1);
}
else {
JL_TIMING(PARSING);
assert(memchr(fname, 0, len) == NULL); // was checked already in jl_load
ast = fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "jl-parse-file")), f);
}
fl_free_gc_handles(fl_ctx, 1);
if (ast == fl_ctx->F) {
jl_ast_ctx_leave(ctx);
jl_errorf("could not open file %s", fname);
}
fl_gc_handle(fl_ctx, &ast);
fl_gc_handle(fl_ctx, &expression);
int last_lineno = jl_lineno;
const char *last_filename = jl_filename;
size_t last_age = jl_get_ptls_states()->world_age;
jl_lineno = 0;
jl_filename = fname;
jl_module_t *old_module = ctx->module;
ctx->module = inmodule;
jl_value_t *form = NULL;
jl_value_t *result = jl_nothing;
int err = 0;
JL_GC_PUSH2(&form, &result);
JL_TRY {
assert(iscons(ast) && car_(ast) == symbol(fl_ctx, "toplevel"));
ast = cdr_(ast);
while (iscons(ast)) {
expression = car_(ast);
{
JL_TIMING(LOWERING);
if (fl_ctx->T == fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "contains-macrocall")), expression)) {
form = scm_to_julia(fl_ctx, expression, inmodule);
form = jl_expand_macros(form, inmodule, NULL, 0);
expression = julia_to_scm(fl_ctx, form);
}
// expand non-final expressions in statement position (value unused)
expression =
fl_applyn(fl_ctx, 1,
symbol_value(symbol(fl_ctx, iscons(cdr_(ast)) ? "jl-expand-to-thunk-stmt" : "jl-expand-to-thunk")),
expression);
}
jl_get_ptls_states()->world_age = jl_world_counter;
form = scm_to_julia(fl_ctx, expression, inmodule);
JL_SIGATOMIC_END();
jl_get_ptls_states()->world_age = jl_world_counter;
if (jl_is_linenode(form))
jl_lineno = jl_linenode_line(form);
else
result = jl_toplevel_eval_flex(inmodule, form, 1, 1);
JL_SIGATOMIC_BEGIN();
ast = cdr_(ast);
}
}
JL_CATCH {
form = jl_pchar_to_string(fname, len);
result = jl_box_long(jl_lineno);
err = 1;
}
jl_get_ptls_states()->world_age = last_age;
jl_lineno = last_lineno;
jl_filename = last_filename;
fl_free_gc_handles(fl_ctx, 2);
ctx->module = old_module;
jl_ast_ctx_leave(ctx);
if (err) {
if (jl_loaderror_type == NULL)
jl_rethrow();
else
jl_rethrow_other(jl_new_struct(jl_loaderror_type, form, result,
ptls->exception_in_transit));
}
JL_GC_POP();
return result;
}
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, jl_module_t *mod)
{
if (fl_isnumber(fl_ctx, e)) {
int64_t i64;
if (isfixnum(e)) {
i64 = numval(e);
}
else {
assert(iscprim(e));
cprim_t *cp = (cprim_t*)ptr(e);
numerictype_t nt = cp_numtype(cp);
switch (nt) {
case T_DOUBLE:
return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp));
case T_FLOAT:
return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp));
case T_UINT8:
return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp));
case T_UINT16:
return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp));
case T_UINT32:
return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp));
case T_UINT64:
return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp));
default:
;
}
i64 = conv_to_int64(cp_data(cp), nt);
}
#ifdef _P64
return (jl_value_t*)jl_box_int64(i64);
#else
if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN)
return (jl_value_t*)jl_box_int64(i64);
else
return (jl_value_t*)jl_box_int32((int32_t)i64);
#endif
}
if (issymbol(e)) {
if (e == jl_ast_ctx(fl_ctx)->true_sym)
return jl_true;
else if (e == jl_ast_ctx(fl_ctx)->false_sym)
return jl_false;
return (jl_value_t*)scmsym_to_julia(fl_ctx, e);
}
if (fl_isstring(fl_ctx, e))
return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e));
if (iscons(e) || e == fl_ctx->NIL) {
value_t hd;
jl_sym_t *sym;
if (e == fl_ctx->NIL) {
hd = e;
}
else {
hd = car_(e);
if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym)
return jl_box_ssavalue(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->slot_sym)
return jl_box_slotnumber(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1)
return jl_nothing;
}
if (issymbol(hd))
sym = scmsym_to_julia(fl_ctx, hd);
else
sym = list_sym;
size_t n = llength(e)-1;
if (issymbol(hd))
e = cdr_(e);
else
n++;
// nodes with special representations
jl_value_t *ex = NULL, *temp = NULL;
if (sym == line_sym && (n == 1 || n == 2)) {
jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), mod);
jl_value_t *file = jl_nothing;
JL_GC_PUSH2(&linenum, &file);
if (n == 2)
file = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
temp = jl_new_struct(jl_linenumbernode_type, linenum, file);
JL_GC_POP();
return temp;
}
JL_GC_PUSH1(&ex);
if (sym == label_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_labelnode_type, ex);
}
else if (sym == goto_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_gotonode_type, ex);
}
else if (sym == newvar_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_newvarnode_type, ex);
}
else if (sym == globalref_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = scm_to_julia_(fl_ctx, car_(cdr_(e)), mod);
assert(jl_is_module(ex));
assert(jl_is_symbol(temp));
temp = jl_module_globalref((jl_module_t*)ex, (jl_sym_t*)temp);
}
else if (sym == top_sym) {
assert(mod && "top should not be generated by the parser");
ex = scm_to_julia_(fl_ctx, car_(e), mod);
assert(jl_is_symbol(ex));
temp = jl_module_globalref(jl_base_relative_to(mod), (jl_sym_t*)ex);
}
else if (sym == core_sym) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
assert(jl_is_symbol(ex));
temp = jl_module_globalref(jl_core_module, (jl_sym_t*)ex);
}
else if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) {
ex = scm_to_julia_(fl_ctx, car_(e), mod);
temp = jl_new_struct(jl_quotenode_type, ex);
}
if (temp) {
JL_GC_POP();
return temp;
}
ex = (jl_value_t*)jl_exprn(sym, n);
size_t i;
for (i = 0; i < n; i++) {
assert(iscons(e));
jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), mod));
e = cdr_(e);
}
if (sym == lambda_sym)
ex = (jl_value_t*)jl_new_code_info_from_ast((jl_expr_t*)ex);
JL_GC_POP();
if (sym == list_sym)
return (jl_value_t*)((jl_expr_t*)ex)->args;
return (jl_value_t*)ex;
}
if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) {
uint32_t c, u = *(uint32_t*)cp_data((cprim_t*)ptr(e));
if (u < 0x80) {
c = u << 24;
} else {
c = ((u << 0) & 0x0000003f) | ((u << 2) & 0x00003f00) |
((u << 4) & 0x003f0000) | ((u << 6) & 0x3f000000);
c = u < 0x00000800 ? (c << 16) | 0xc0800000 :
u < 0x00010000 ? (c << 8) | 0xe0808000 :
(c << 0) | 0xf0808080 ;
}
return jl_box_char(c);
}
if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) {
return *(jl_value_t**)cv_data((cvalue_t*)ptr(e));
}
jl_error("malformed tree");
}
static jl_value_t *scm_to_julia_(fl_context_t *fl_ctx, value_t e, int eo)
{
if (fl_isnumber(fl_ctx, e)) {
int64_t i64;
if (isfixnum(e)) {
i64 = numval(e);
}
else {
assert(iscprim(e));
cprim_t *cp = (cprim_t*)ptr(e);
numerictype_t nt = cp_numtype(cp);
switch (nt) {
case T_DOUBLE:
return (jl_value_t*)jl_box_float64(*(double*)cp_data(cp));
case T_FLOAT:
return (jl_value_t*)jl_box_float32(*(float*)cp_data(cp));
case T_UINT8:
return (jl_value_t*)jl_box_uint8(*(uint8_t*)cp_data(cp));
case T_UINT16:
return (jl_value_t*)jl_box_uint16(*(uint16_t*)cp_data(cp));
case T_UINT32:
return (jl_value_t*)jl_box_uint32(*(uint32_t*)cp_data(cp));
case T_UINT64:
return (jl_value_t*)jl_box_uint64(*(uint64_t*)cp_data(cp));
default:
;
}
i64 = conv_to_int64(cp_data(cp), nt);
}
#ifdef _P64
return (jl_value_t*)jl_box_int64(i64);
#else
if (i64 > (int64_t)S32_MAX || i64 < (int64_t)S32_MIN)
return (jl_value_t*)jl_box_int64(i64);
else
return (jl_value_t*)jl_box_int32((int32_t)i64);
#endif
}
if (issymbol(e)) {
if (e == jl_ast_ctx(fl_ctx)->true_sym)
return jl_true;
else if (e == jl_ast_ctx(fl_ctx)->false_sym)
return jl_false;
return (jl_value_t*)scmsym_to_julia(fl_ctx, e);
}
if (fl_isstring(fl_ctx, e))
return jl_pchar_to_string((char*)cvalue_data(e), cvalue_len(e));
if (iscons(e) || e == fl_ctx->NIL) {
value_t hd;
jl_sym_t *sym;
if (e == fl_ctx->NIL) {
hd = e;
}
else {
hd = car_(e);
if (hd == jl_ast_ctx(fl_ctx)->ssavalue_sym)
return jl_box_ssavalue(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->slot_sym)
return jl_box_slotnumber(numval(car_(cdr_(e))));
else if (hd == jl_ast_ctx(fl_ctx)->null_sym && llength(e) == 1)
return jl_nothing;
}
if (issymbol(hd))
sym = scmsym_to_julia(fl_ctx, hd);
else
sym = list_sym;
size_t n = llength(e)-1;
if (issymbol(hd))
e = cdr_(e);
else
n++;
if (!eo) {
if (sym == line_sym && n==1) {
jl_value_t *linenum = scm_to_julia_(fl_ctx, car_(e), 0);
JL_GC_PUSH1(&linenum);
jl_value_t *temp = jl_new_struct(jl_linenumbernode_type, linenum);
JL_GC_POP();
return temp;
}
jl_value_t *scmv = NULL, *temp = NULL;
JL_GC_PUSH1(&scmv);
if (sym == label_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
temp = jl_new_struct(jl_labelnode_type, scmv);
JL_GC_POP();
return temp;
}
if (sym == goto_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
temp = jl_new_struct(jl_gotonode_type, scmv);
JL_GC_POP();
return temp;
}
if (sym == inert_sym || (sym == quote_sym && (!iscons(car_(e))))) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
temp = jl_new_struct(jl_quotenode_type, scmv);
JL_GC_POP();
return temp;
}
if (sym == top_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
assert(jl_is_symbol(scmv));
temp = jl_module_globalref(jl_base_relative_to(jl_current_module), (jl_sym_t*)scmv);
JL_GC_POP();
return temp;
}
if (sym == core_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
assert(jl_is_symbol(scmv));
temp = jl_module_globalref(jl_core_module, (jl_sym_t*)scmv);
JL_GC_POP();
return temp;
}
if (sym == globalref_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
temp = scm_to_julia_(fl_ctx,car_(cdr_(e)),0);
assert(jl_is_module(scmv));
assert(jl_is_symbol(temp));
temp = jl_module_globalref((jl_module_t*)scmv, (jl_sym_t*)temp);
JL_GC_POP();
return temp;
}
if (sym == newvar_sym) {
scmv = scm_to_julia_(fl_ctx,car_(e),0);
temp = jl_new_struct(jl_newvarnode_type, scmv);
JL_GC_POP();
return temp;
}
JL_GC_POP();
}
else if (sym == inert_sym && !iscons(car_(e))) {
sym = quote_sym;
}
jl_value_t *ex = (jl_value_t*)jl_exprn(sym, n);
JL_GC_PUSH1(&ex);
// allocate a fresh args array for empty exprs passed to macros
if (eo && n == 0) {
((jl_expr_t*)ex)->args = jl_alloc_vec_any(0);
jl_gc_wb(ex, ((jl_expr_t*)ex)->args);
}
size_t i;
for(i=0; i < n; i++) {
assert(iscons(e));
jl_array_ptr_set(((jl_expr_t*)ex)->args, i, scm_to_julia_(fl_ctx, car_(e), eo));
e = cdr_(e);
}
if (sym == lambda_sym)
ex = (jl_value_t*)jl_new_lambda_info_from_ast((jl_expr_t*)ex);
JL_GC_POP();
if (sym == list_sym)
return (jl_value_t*)((jl_expr_t*)ex)->args;
return (jl_value_t*)ex;
}
if (iscprim(e) && cp_class((cprim_t*)ptr(e)) == fl_ctx->wchartype) {
return jl_box32(jl_char_type, *(int32_t*)cp_data((cprim_t*)ptr(e)));
}
if (iscvalue(e) && cv_class((cvalue_t*)ptr(e)) == jl_ast_ctx(fl_ctx)->jvtype) {
return *(jl_value_t**)cv_data((cvalue_t*)ptr(e));
}
jl_error("malformed tree");
return jl_nothing;
}
