mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-22 07:09:18 +02:00
moving library initialization logic from main.c to eval.c.
main is just minimal option parsing plus a simple repl now. still need to switch to using a module path instead of a single module dir.
This commit is contained in:
Alex Shinn
parent
6fe11ffcd1
commit
d978e750aa
8 changed files with 162 additions and 148 deletions
2
Makefile
2
Makefile
|
|
@ -91,7 +91,7 @@ INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h
|
|||
|
||||
include/chibi/install.h: Makefile
|
||||
echo '#define sexp_so_extension "'$(SO)'"' > $@
|
||||
echo '#define sexp_module_dir "'$(MODDIR)'"' >> $@
|
||||
echo '#define sexp_default_module_dir "'$(MODDIR)'"' >> $@
|
||||
echo '#define sexp_platform "'$(PLATFORM)'"' >> $@
|
||||
|
||||
sexp.o: sexp.c gc.c opt/bignum.c $(INCLUDES) Makefile
|
||||
|
|
|
|||
6
README
6
README
|
|
@ -44,7 +44,11 @@ The essential functions to remember are:
|
|||
#include <chibi/eval.h>
|
||||
|
||||
sexp_make_eval_context(NULL, NULL, NULL)
|
||||
returns a new context with a fresh stack and standard environment
|
||||
returns a new context with a fresh stack and primitive environment
|
||||
|
||||
sexp_load_standard_env(context, env, version)
|
||||
loads the init.scm file in primitive environment env
|
||||
(version should be SEXP_FIVE)
|
||||
|
||||
sexp_destroy_context(context)
|
||||
free a context and all associated memory
|
||||
|
|
|
|||
164
eval.c
164
eval.c
|
|
@ -7,6 +7,7 @@
|
|||
/************************************************************************/
|
||||
|
||||
static int scheme_initialized_p = 0;
|
||||
char *sexp_module_dir = NULL;
|
||||
|
||||
#if SEXP_USE_DEBUG
|
||||
#include "opt/debug.c"
|
||||
|
|
@ -18,8 +19,6 @@ static int scheme_initialized_p = 0;
|
|||
|
||||
static sexp analyze (sexp ctx, sexp x);
|
||||
static void generate (sexp ctx, sexp x);
|
||||
static sexp sexp_make_null_env (sexp ctx, sexp version);
|
||||
static sexp sexp_make_standard_env (sexp ctx, sexp version);
|
||||
|
||||
static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) {
|
||||
sexp exn;
|
||||
|
|
@ -135,7 +134,7 @@ static int sexp_param_index (sexp lambda, sexp name) {
|
|||
static void shrink_bcode (sexp ctx, sexp_uint_t i) {
|
||||
sexp tmp;
|
||||
if (sexp_bytecode_length(sexp_context_bc(ctx)) != i) {
|
||||
tmp = sexp_alloc_tagged(ctx, sexp_sizeof(bytecode) + i, SEXP_BYTECODE);
|
||||
tmp = sexp_alloc_bytecode(ctx, i);
|
||||
sexp_bytecode_name(tmp) = SEXP_FALSE;
|
||||
sexp_bytecode_length(tmp) = i;
|
||||
sexp_bytecode_literals(tmp)
|
||||
|
|
@ -151,10 +150,7 @@ static void expand_bcode (sexp ctx, sexp_uint_t size) {
|
|||
sexp tmp;
|
||||
if (sexp_bytecode_length(sexp_context_bc(ctx))
|
||||
< (sexp_context_pos(ctx))+size) {
|
||||
tmp = sexp_alloc_tagged(ctx,
|
||||
sexp_sizeof(bytecode)
|
||||
+ sexp_bytecode_length(sexp_context_bc(ctx))*2,
|
||||
SEXP_BYTECODE);
|
||||
tmp=sexp_alloc_bytecode(ctx, sexp_bytecode_length(sexp_context_bc(ctx))*2);
|
||||
sexp_bytecode_name(tmp) = SEXP_FALSE;
|
||||
sexp_bytecode_length(tmp)
|
||||
= sexp_bytecode_length(sexp_context_bc(ctx))*2;
|
||||
|
|
@ -298,9 +294,7 @@ sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env) {
|
|||
sexp_gc_var1(res);
|
||||
if (ctx) sexp_gc_preserve1(ctx, res);
|
||||
res = sexp_make_context(ctx);
|
||||
sexp_context_bc(res)
|
||||
= sexp_alloc_tagged(res, sexp_sizeof(bytecode)+SEXP_INIT_BCODE_SIZE,
|
||||
SEXP_BYTECODE);
|
||||
sexp_context_bc(res) = sexp_alloc_bytecode(res, SEXP_INIT_BCODE_SIZE);
|
||||
sexp_bytecode_name(sexp_context_bc(res)) = SEXP_FALSE;
|
||||
sexp_bytecode_length(sexp_context_bc(res)) = SEXP_INIT_BCODE_SIZE;
|
||||
sexp_bytecode_literals(sexp_context_bc(res)) = SEXP_NULL;
|
||||
|
|
@ -311,8 +305,7 @@ sexp sexp_make_eval_context (sexp ctx, sexp stack, sexp env) {
|
|||
}
|
||||
sexp_context_stack(res) = stack;
|
||||
if (! ctx) sexp_init_eval_context_globals(res);
|
||||
sexp_context_env(res)
|
||||
= (env ? env : sexp_make_standard_env(res, sexp_make_fixnum(5)));
|
||||
sexp_context_env(res) = (env ? env : sexp_make_primitive_env(res, SEXP_FIVE));
|
||||
if (ctx) sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
|
@ -2204,20 +2197,7 @@ static sexp sexp_apply_optimization (sexp ctx, sexp proc, sexp ast) {
|
|||
#include "opt/simplify.c"
|
||||
#endif
|
||||
|
||||
/*********************** standard environment *************************/
|
||||
|
||||
static struct sexp_struct core_forms[] = {
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE, "define"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_SET, "set!"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LAMBDA, "lambda"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_IF, "if"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_BEGIN, "begin"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_QUOTE, "quote"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_SYNTAX_QUOTE, "syntax-quote"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE_SYNTAX, "define-syntax"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LET_SYNTAX, "let-syntax"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LETREC_SYNTAX, "letrec-syntax"}}},
|
||||
};
|
||||
/***************************** opcodes ********************************/
|
||||
|
||||
#include "opcodes.c"
|
||||
|
||||
|
|
@ -2342,6 +2322,21 @@ sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index) {
|
|||
|
||||
#endif
|
||||
|
||||
/*********************** standard environment *************************/
|
||||
|
||||
static struct sexp_struct core_forms[] = {
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE, "define"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_SET, "set!"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LAMBDA, "lambda"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_IF, "if"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_BEGIN, "begin"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_QUOTE, "quote"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_SYNTAX_QUOTE, "syntax-quote"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_DEFINE_SYNTAX, "define-syntax"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LET_SYNTAX, "let-syntax"}}},
|
||||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LETREC_SYNTAX, "letrec-syntax"}}},
|
||||
};
|
||||
|
||||
sexp sexp_make_env (sexp ctx) {
|
||||
sexp e = sexp_alloc_type(ctx, env, SEXP_ENV);
|
||||
sexp_env_lambda(e) = NULL;
|
||||
|
|
@ -2350,7 +2345,7 @@ sexp sexp_make_env (sexp ctx) {
|
|||
return e;
|
||||
}
|
||||
|
||||
static sexp sexp_make_null_env (sexp ctx, sexp version) {
|
||||
sexp sexp_make_null_env (sexp ctx, sexp version) {
|
||||
sexp_uint_t i;
|
||||
sexp e = sexp_make_env(ctx);
|
||||
for (i=0; i<(sizeof(core_forms)/sizeof(core_forms[0])); i++)
|
||||
|
|
@ -2359,21 +2354,88 @@ static sexp sexp_make_null_env (sexp ctx, sexp version) {
|
|||
return e;
|
||||
}
|
||||
|
||||
static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||
sexp_uint_t i;
|
||||
sexp cell, sym;
|
||||
sexp_gc_var4(e, op, tmp, err_handler);
|
||||
sexp_gc_preserve4(ctx, e, op, tmp, err_handler);
|
||||
sexp sexp_make_primitive_env (sexp ctx, sexp version) {
|
||||
int i;
|
||||
sexp_gc_var3(e, op, sym);
|
||||
sexp_gc_preserve3(ctx, e, op, sym);
|
||||
e = sexp_make_null_env(ctx, version);
|
||||
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
||||
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_data(op)) {
|
||||
sym = sexp_intern(ctx, (char*)sexp_opcode_data(op));
|
||||
cell = sexp_env_cell_create(ctx, e, sym, SEXP_VOID);
|
||||
sexp_opcode_data(op) = cell;
|
||||
sexp_opcode_data(op) = sexp_env_cell_create(ctx, e, sym, SEXP_VOID);
|
||||
}
|
||||
sexp_env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
|
||||
}
|
||||
sexp_gc_release3(ctx);
|
||||
return e;
|
||||
}
|
||||
|
||||
#ifdef PLAN9
|
||||
#define file_exists_p(path, buf) (stat(path, buf, 128) >= 0)
|
||||
#else
|
||||
#include <sys/stat.h>
|
||||
#define file_exists_p(path, buf) (! stat(path, buf))
|
||||
#endif
|
||||
|
||||
sexp sexp_find_module_file (sexp ctx, char *file) {
|
||||
sexp res;
|
||||
int mlen, flen;
|
||||
char *path;
|
||||
#ifdef PLAN9
|
||||
unsigned char buf[128];
|
||||
#else
|
||||
struct stat buf_str;
|
||||
struct stat *buf = &buf_str;
|
||||
#endif
|
||||
|
||||
if (file_exists_p(file, buf))
|
||||
return sexp_c_string(ctx, file, -1);
|
||||
if (! sexp_module_dir) {
|
||||
#ifndef PLAN9
|
||||
sexp_module_dir = getenv("CHIBI_MODULE_DIR");
|
||||
if (! sexp_module_dir)
|
||||
#endif
|
||||
sexp_module_dir = sexp_module_dir;
|
||||
}
|
||||
mlen = strlen(sexp_module_dir);
|
||||
flen = strlen(file);
|
||||
path = (char*) malloc(mlen+flen+2);
|
||||
memcpy(path, sexp_module_dir, mlen);
|
||||
path[mlen] = '/';
|
||||
memcpy(path+mlen+1, file, flen);
|
||||
path[mlen+flen+1] = '\0';
|
||||
if (file_exists_p(path, buf))
|
||||
res = sexp_c_string(ctx, path, mlen+flen+2);
|
||||
else
|
||||
res = SEXP_FALSE;
|
||||
free(path);
|
||||
return res;
|
||||
}
|
||||
|
||||
#define sexp_file_not_found "couldn't find file to load in ./ or module dir"
|
||||
|
||||
sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
|
||||
sexp res = SEXP_VOID;
|
||||
sexp_gc_var2(path, irr);
|
||||
sexp_gc_preserve2(ctx, path, irr);
|
||||
path = sexp_find_module_file(ctx, file);
|
||||
if (! sexp_stringp(path)) {
|
||||
path = sexp_c_string(ctx, sexp_module_dir, -1);
|
||||
irr = sexp_cons(ctx, path, SEXP_NULL);
|
||||
path = sexp_c_string(ctx, file, -1);
|
||||
irr = sexp_cons(ctx, path, irr);
|
||||
res = sexp_user_exception(ctx, SEXP_FALSE, sexp_file_not_found, irr);
|
||||
} else {
|
||||
res = sexp_load(ctx, path, env);
|
||||
}
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
||||
sexp_gc_var3(op, tmp, sym);
|
||||
sexp_gc_preserve3(ctx, op, tmp, sym);
|
||||
/* add io port and interaction env parameters */
|
||||
sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_CUR_IN_SYMBOL),
|
||||
sexp_make_input_port(ctx, stdin, SEXP_FALSE));
|
||||
|
|
@ -2382,8 +2444,8 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_CUR_ERR_SYMBOL),
|
||||
sexp_make_output_port(ctx, stderr, SEXP_FALSE));
|
||||
sexp_env_define(ctx, e, sexp_global(ctx, SEXP_G_INTERACTION_ENV_SYMBOL), e);
|
||||
sexp_env_define(ctx, e, sexp_intern(ctx, "*module-directory*"),
|
||||
sexp_c_string(ctx, sexp_module_dir, -1));
|
||||
sexp_env_define(ctx, e, sym=sexp_intern(ctx, "*module-directory*"),
|
||||
sexp_c_string(ctx, sexp_default_module_dir, -1));
|
||||
#if SEXP_USE_DL
|
||||
sexp_env_define(ctx, e, sexp_intern(ctx, "*shared-object-extension*"),
|
||||
sexp_c_string(ctx, sexp_so_extension, -1));
|
||||
|
|
@ -2398,8 +2460,34 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
tmp = sexp_cons(ctx, sexp_make_fixnum(500), op);
|
||||
sexp_push(ctx, sexp_global(ctx, SEXP_G_OPTIMIZATIONS), tmp);
|
||||
#endif
|
||||
sexp_gc_release4(ctx);
|
||||
return e;
|
||||
/* load init.scm */
|
||||
tmp = sexp_load_module_file(ctx, sexp_init_file, e);
|
||||
/* load and bind config env */
|
||||
#if SEXP_USE_MODULES
|
||||
if (! sexp_exceptionp(tmp)) {
|
||||
sym = sexp_intern(ctx, "*config-env*");
|
||||
if (! sexp_envp(tmp=sexp_global(ctx, SEXP_G_CONFIG_ENV))) {
|
||||
tmp = sexp_make_env(ctx);
|
||||
if (! sexp_exceptionp(tmp)) {
|
||||
sexp_env_copy(ctx, tmp, e, SEXP_FALSE);
|
||||
sexp_global(ctx, SEXP_G_CONFIG_ENV) = tmp;
|
||||
sexp_env_define(ctx, tmp, sym, tmp);
|
||||
}
|
||||
}
|
||||
sexp_env_define(ctx, e, sym, tmp);
|
||||
}
|
||||
#endif
|
||||
sexp_gc_release3(ctx);
|
||||
return sexp_exceptionp(tmp) ? tmp : e;
|
||||
}
|
||||
|
||||
sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||
sexp_gc_var1(env);
|
||||
sexp_gc_preserve1(ctx, env);
|
||||
env = sexp_make_primitive_env(ctx, version);
|
||||
if (! sexp_exceptionp(env)) sexp_load_standard_env(ctx, env, version);
|
||||
sexp_gc_release1(ctx);
|
||||
return env;
|
||||
}
|
||||
|
||||
sexp sexp_env_copy (sexp ctx, sexp to, sexp from, sexp ls) {
|
||||
|
|
|
|||
|
|
@ -15,6 +15,8 @@
|
|||
#define sexp_init_file "init.scm"
|
||||
#define sexp_config_file "config.scm"
|
||||
|
||||
SEXP_API char *sexp_module_dir;
|
||||
|
||||
enum sexp_core_form_names {
|
||||
SEXP_CORE_DEFINE = 1,
|
||||
SEXP_CORE_SET,
|
||||
|
|
@ -129,6 +131,11 @@ SEXP_API sexp sexp_eval (sexp context, sexp obj, sexp env);
|
|||
SEXP_API sexp sexp_eval_string (sexp context, char *str, sexp env);
|
||||
SEXP_API sexp sexp_load (sexp context, sexp expr, sexp env);
|
||||
SEXP_API sexp sexp_make_env (sexp context);
|
||||
SEXP_API sexp sexp_make_null_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_make_primitive_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_make_standard_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version);
|
||||
SEXP_API sexp sexp_load_module_file (sexp ctx, char *file, sexp env);
|
||||
SEXP_API sexp sexp_extend_env (sexp context, sexp env, sexp vars, sexp value);
|
||||
SEXP_API sexp sexp_env_copy (sexp context, sexp to, sexp from, sexp ls);
|
||||
SEXP_API void sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
|
||||
|
|
|
|||
|
|
@ -357,6 +357,7 @@ void *sexp_realloc(sexp ctx, sexp x, size_t size);
|
|||
#define sexp_sizeof_header (sexp_sizeof(flonum) - sizeof(double))
|
||||
|
||||
#define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
|
||||
#define sexp_alloc_bytecode(ctx, i) sexp_alloc_tagged(ctx, sexp_sizeof(bytecode) + i, SEXP_BYTECODE)
|
||||
|
||||
#if SEXP_USE_BIGNUMS
|
||||
#include "chibi/bignum.h"
|
||||
|
|
@ -460,6 +461,8 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
|||
#define SEXP_ONE sexp_make_fixnum(1)
|
||||
#define SEXP_TWO sexp_make_fixnum(2)
|
||||
#define SEXP_THREE sexp_make_fixnum(3)
|
||||
#define SEXP_FOUR sexp_make_fixnum(4)
|
||||
#define SEXP_FIVE sexp_make_fixnum(5)
|
||||
|
||||
#define sexp_make_character(n) ((sexp) ((((sexp_sint_t)(n))<<SEXP_EXTENDED_BITS) + SEXP_CHAR_TAG))
|
||||
#define sexp_unbox_character(n) ((int) (((sexp_sint_t)(n))>>SEXP_EXTENDED_BITS))
|
||||
|
|
@ -682,6 +685,7 @@ enum sexp_context_globals {
|
|||
SEXP_G_OOM_ERROR, /* out of memory exception object */
|
||||
SEXP_G_OOS_ERROR, /* out of stack exception object */
|
||||
SEXP_G_OPTIMIZATIONS,
|
||||
SEXP_G_CONFIG_ENV,
|
||||
SEXP_G_QUOTE_SYMBOL,
|
||||
SEXP_G_QUASIQUOTE_SYMBOL,
|
||||
SEXP_G_UNQUOTE_SYMBOL,
|
||||
|
|
|
|||
2
init.scm
2
init.scm
|
|
@ -552,8 +552,6 @@
|
|||
(current-output-port old-out)
|
||||
res)))
|
||||
|
||||
(define (command-line-arguments) *command-line-arguments*)
|
||||
|
||||
;; values
|
||||
|
||||
(define *values-tag* (list 'values))
|
||||
|
|
|
|||
123
main.c
123
main.c
|
|
@ -2,95 +2,12 @@
|
|||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#ifdef PLAN9
|
||||
#define file_exists_p(path, buf) (stat(path, buf, 128) >= 0)
|
||||
#else
|
||||
#include <sys/stat.h>
|
||||
#define file_exists_p(path, buf) (! stat(path, buf))
|
||||
#endif
|
||||
|
||||
#include "chibi/eval.h"
|
||||
|
||||
char *chibi_module_dir = NULL;
|
||||
#define sexp_argv_symbol "*command-line-arguments*"
|
||||
#define sexp_argv_proc "(define (command-line-arguments) "sexp_argv_symbol")"
|
||||
|
||||
sexp find_module_file (sexp ctx, char *file) {
|
||||
sexp res;
|
||||
int mlen, flen;
|
||||
char *path;
|
||||
#ifdef PLAN9
|
||||
unsigned char buf[128];
|
||||
#else
|
||||
struct stat buf_str;
|
||||
struct stat *buf = &buf_str;
|
||||
#endif
|
||||
|
||||
if (file_exists_p(file, buf))
|
||||
return sexp_c_string(ctx, file, -1);
|
||||
if (! chibi_module_dir) {
|
||||
#ifndef PLAN9
|
||||
chibi_module_dir = getenv("CHIBI_MODULE_DIR");
|
||||
if (! chibi_module_dir)
|
||||
#endif
|
||||
chibi_module_dir = sexp_module_dir;
|
||||
}
|
||||
mlen = strlen(chibi_module_dir);
|
||||
flen = strlen(file);
|
||||
path = (char*) malloc(mlen+flen+2);
|
||||
memcpy(path, chibi_module_dir, mlen);
|
||||
path[mlen] = '/';
|
||||
memcpy(path+mlen+1, file, flen);
|
||||
path[mlen+flen+1] = '\0';
|
||||
if (file_exists_p(path, buf))
|
||||
res = sexp_c_string(ctx, path, mlen+flen+2);
|
||||
else
|
||||
res = SEXP_FALSE;
|
||||
free(path);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
|
||||
sexp res = SEXP_VOID;
|
||||
sexp_gc_var2(path, irr);
|
||||
sexp_gc_preserve2(ctx, path, irr);
|
||||
path = find_module_file(ctx, file);
|
||||
if (! sexp_stringp(path)) {
|
||||
path = sexp_c_string(ctx, chibi_module_dir, -1);
|
||||
irr = sexp_cons(ctx, path, SEXP_NULL);
|
||||
path = sexp_c_string(ctx, file, -1);
|
||||
irr = sexp_cons(ctx, path, irr);
|
||||
res = sexp_user_exception(ctx,
|
||||
SEXP_FALSE,
|
||||
"couldn't find file to load in ./ or module dir",
|
||||
irr);
|
||||
} else {
|
||||
res = sexp_load(ctx, path, env);
|
||||
}
|
||||
sexp_gc_release2(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_init_environments (sexp ctx) {
|
||||
sexp res, env;
|
||||
sexp_gc_var1(confenv);
|
||||
env = sexp_context_env(ctx);
|
||||
sexp_env_define(ctx, env, sexp_intern(ctx, "*command-line-arguments*"), SEXP_NULL);
|
||||
res = sexp_load_module_file(ctx, sexp_init_file, env);
|
||||
#if SEXP_USE_MODULES
|
||||
if (! sexp_exceptionp(res)) {
|
||||
res = SEXP_UNDEF;
|
||||
sexp_gc_preserve1(ctx, confenv);
|
||||
confenv = sexp_make_env(ctx);
|
||||
sexp_env_copy(ctx, confenv, env, SEXP_FALSE);
|
||||
sexp_load_module_file(ctx, sexp_config_file, confenv);
|
||||
sexp_env_define(ctx, env, sexp_intern(ctx, "*config-env*"), confenv);
|
||||
sexp_env_define(ctx, confenv, sexp_intern(ctx, "*config-env*"), confenv);
|
||||
sexp_gc_release1(ctx);
|
||||
}
|
||||
#endif
|
||||
return res;
|
||||
}
|
||||
|
||||
void repl (sexp ctx) {
|
||||
static void repl (sexp ctx) {
|
||||
sexp in, out, err;
|
||||
sexp_gc_var4(obj, tmp, res, env);
|
||||
sexp_gc_preserve4(ctx, obj, tmp, res, env);
|
||||
|
|
@ -128,11 +45,11 @@ void repl (sexp ctx) {
|
|||
sexp_gc_release4(ctx);
|
||||
}
|
||||
|
||||
sexp check_exception (sexp ctx, sexp res) {
|
||||
static sexp check_exception (sexp ctx, sexp res) {
|
||||
sexp err;
|
||||
if (res && sexp_exceptionp(res)) {
|
||||
sexp_print_exception(ctx, res,
|
||||
sexp_eval_string(ctx, "(current-error-port)",
|
||||
sexp_context_env(ctx)));
|
||||
err = sexp_current_error_port(ctx);
|
||||
if (sexp_oportp(err)) sexp_print_exception(ctx, res, err);
|
||||
exit_failure();
|
||||
}
|
||||
return res;
|
||||
|
|
@ -155,15 +72,10 @@ void run_main (int argc, char **argv) {
|
|||
case 'e':
|
||||
case 'p':
|
||||
if (! init_loaded++)
|
||||
sexp_init_environments(ctx);
|
||||
res = sexp_read_from_string(ctx, argv[i+1]);
|
||||
if (! sexp_exceptionp(res))
|
||||
res = sexp_eval(ctx, res, env);
|
||||
if (sexp_exceptionp(res)) {
|
||||
sexp_print_exception(ctx, res, out);
|
||||
quit = 1;
|
||||
break;
|
||||
} else if (argv[i][1] == 'p') {
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
check_exception(ctx, sexp_read_from_string(ctx, argv[i+1]));
|
||||
check_exception(ctx, sexp_eval(ctx, res, env));
|
||||
if (argv[i][1] == 'p') {
|
||||
sexp_write(ctx, res, out);
|
||||
sexp_write_char(ctx, '\n', out);
|
||||
}
|
||||
|
|
@ -172,14 +84,14 @@ void run_main (int argc, char **argv) {
|
|||
break;
|
||||
case 'l':
|
||||
if (! init_loaded++)
|
||||
sexp_init_environments(ctx);
|
||||
sexp_load_module_file(ctx, argv[++i], env);
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
check_exception(ctx, sexp_load_module_file(ctx, argv[++i], env));
|
||||
break;
|
||||
case 'q':
|
||||
init_loaded = 1;
|
||||
break;
|
||||
case 'm':
|
||||
chibi_module_dir = argv[++i];
|
||||
sexp_module_dir = argv[++i];
|
||||
break;
|
||||
case 's':
|
||||
for (argc=argc-1; argc>i+1; argc--)
|
||||
|
|
@ -193,11 +105,12 @@ void run_main (int argc, char **argv) {
|
|||
|
||||
if (! quit) {
|
||||
if (! init_loaded)
|
||||
res = check_exception(ctx, sexp_init_environments(ctx));
|
||||
sexp_env_define(ctx, env, sexp_intern(ctx, "*command-line-arguments*"), args);
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
sexp_env_define(ctx, env, sexp_intern(ctx, sexp_argv_symbol), args);
|
||||
sexp_eval_string(ctx, sexp_argv_proc, env);
|
||||
if (i < argc)
|
||||
for ( ; i < argc; i++)
|
||||
res = check_exception(ctx, sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env));
|
||||
check_exception(ctx, sexp_load(ctx, str=sexp_c_string(ctx, argv[i], -1), env));
|
||||
else
|
||||
repl(ctx);
|
||||
}
|
||||
|
|
|
|||
2
mkfile
2
mkfile
|
|
@ -13,7 +13,7 @@ HFILES=include/chibi/sexp.h include/chibi/eval.h include/chibi/config.h include/
|
|||
</sys/src/cmd/mkone
|
||||
|
||||
include/chibi/install.h: mkfile
|
||||
echo '#define sexp_module_dir "'$MODDIR'"' > include/chibi/install.h
|
||||
echo '#define sexp_default_module_dir "'$MODDIR'"' > include/chibi/install.h
|
||||
echo '#define sexp_platform "plan9"' >> include/chibi/install.h
|
||||
|
||||
install:V: $BIN/$TARG
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue