jl_value_t *jl_load_file_string(const char *text, char *filename)
{
value_t t, f;
t = cvalue_static_cstring(text);
fl_gc_handle(&t);
f = cvalue_static_cstring(filename);
fl_applyn(2, symbol_value(symbol("jl-parse-string-stream")),
t, f);
fl_free_gc_handles(1);
return jl_parse_eval_all(filename);
}
int jl_start_parsing_file(const char *fname)
{
value_t s = cvalue_static_cstring(fname);
if (fl_applyn(1, symbol_value(symbol("jl-parse-file")), s) == FL_F)
return 1;
return 0;
}
// this is used to parse a line of repl input
DLLEXPORT jl_value_t *jl_parse_input_line(const char *str)
{
value_t e = fl_applyn(1, symbol_value(symbol("jl-parse-string")),
cvalue_static_cstring(str));
if (e == FL_T || e == FL_F || e == FL_EOF)
return jl_nothing;
return scm_to_julia(e);
}
static value_t fl_os_getenv(value_t *args, uint32_t nargs)
{
argcount("os.getenv", nargs, 1);
char *name = tostring(args[0], "os.getenv");
char *val = getenv(name);
if (val == NULL) return FL_F;
if (*val == 0)
return symbol_value(emptystringsym);
return cvalue_static_cstring(val);
}
static value_t julia_to_scm(jl_value_t *v)
{
value_t temp;
// need try/catch to reset GC handle stack in case of error
FL_TRY_EXTERN {
temp = julia_to_scm_(v);
}
FL_CATCH_EXTERN {
temp = fl_list2(fl_error_sym, cvalue_static_cstring("expression too large"));
}
return temp;
}
static value_t julia_to_scm(fl_context_t *fl_ctx, jl_value_t *v)
{
value_t temp;
// need try/catch to reset GC handle stack in case of error
FL_TRY_EXTERN(fl_ctx) {
temp = julia_to_scm_(fl_ctx, v);
}
FL_CATCH_EXTERN(fl_ctx) {
temp = fl_list2(fl_ctx, jl_ast_ctx(fl_ctx)->error_sym, cvalue_static_cstring(fl_ctx, "expression too large"));
}
return temp;
}
static value_t argv_list(int argc, char *argv[])
{
int i;
value_t lst=FL_NIL, temp;
fl_gc_handle(&lst);
fl_gc_handle(&temp);
for(i=argc-1; i >= 0; i--) {
temp = cvalue_static_cstring(argv[i]);
lst = fl_cons(temp, lst);
}
fl_free_gc_handles(2);
return lst;
}
static value_t argv_list(fl_context_t *fl_ctx, int argc, char *argv[])
{
int i;
value_t lst=fl_ctx->NIL, temp;
fl_gc_handle(fl_ctx, &lst);
fl_gc_handle(fl_ctx, &temp);
for(i=argc-1; i >= 0; i--) {
temp = cvalue_static_cstring(fl_ctx, argv[i]);
lst = fl_cons(fl_ctx, temp, lst);
}
fl_free_gc_handles(fl_ctx, 2);
return lst;
}
// this is for parsing one expression out of a string, keeping track of
// the current position.
DLLEXPORT jl_value_t *jl_parse_string(const char *str, int pos0, int greedy)
{
value_t s = cvalue_static_cstring(str);
value_t p = fl_applyn(3, symbol_value(symbol("jl-parse-one-string")),
s, fixnum(pos0), greedy?FL_T:FL_F);
jl_value_t *expr=NULL, *pos1=NULL;
JL_GC_PUSH(&expr, &pos1);
value_t e = car_(p);
if (e == FL_T || e == FL_F || e == FL_EOF) {
expr = (jl_value_t*)jl_null;
}
else {
expr = scm_to_julia(e);
}
pos1 = jl_box_long(toulong(cdr_(p),"parse"));
jl_value_t *result = (jl_value_t*)jl_tuple2(expr, pos1);
JL_GC_POP();
return result;
}
int main(int argc, char *argv[])
{
char fname_buf[1024];
fl_context_t *fl_ctx = &fl_global_ctx;
fl_init(fl_ctx, 512*1024);
fname_buf[0] = '\0';
value_t str = symbol_value(symbol(fl_ctx, "*install-dir*"));
char *exedir = (char*)(str == UNBOUND ? NULL : cvalue_data(str));
if (exedir != NULL) {
strcat(fname_buf, exedir);
strcat(fname_buf, PATHSEPSTRING);
}
strcat(fname_buf, "flisp.boot");
value_t args[2];
fl_gc_handle(fl_ctx, &args[0]);
fl_gc_handle(fl_ctx, &args[1]);
FL_TRY_EXTERN(fl_ctx) {
args[0] = cvalue_static_cstring(fl_ctx, fname_buf);
args[1] = symbol(fl_ctx, ":read");
value_t f = fl_file(fl_ctx, &args[0], 2);
fl_free_gc_handles(fl_ctx, 2);
if (fl_load_system_image(fl_ctx, f))
return 1;
(void)fl_applyn(fl_ctx, 1, symbol_value(symbol(fl_ctx, "__start")),
argv_list(fl_ctx, argc, argv));
}
FL_CATCH_EXTERN(fl_ctx) {
ios_puts("fatal error:\n", ios_stderr);
fl_print(fl_ctx, ios_stderr, fl_ctx->lasterror);
ios_putc('\n', ios_stderr);
return 1;
}
return 0;
}
void jl_load_file_string(const char *text)
{
fl_applyn(1, symbol_value(symbol("jl-parse-string-stream")),
cvalue_static_cstring(text));
jl_parse_eval_all("");
}
void jl_start_parsing_file(const char *fname)
{
fl_applyn(1, symbol_value(symbol("jl-parse-file")),
cvalue_static_cstring(fname));
}
