mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-21 14:49:18 +02:00
adding support for module search paths
You want to use the CHIBI_MODULE_PATH environment variable now, not CHIBI_MODULE_DIR, and can use : separators as expected. The default main now also accepts -I<dir> and -A<dir> to prepend or append module directories. The default path is ".:./lib:$PREFIX/share/chibi". The first two may be removed in a future version.
This commit is contained in:
Alex Shinn
parent
b0bcf1a0e6
commit
828c6cc35a
6 changed files with 143 additions and 73 deletions
11
config.scm
11
config.scm
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
(define *modules* '())
|
||||
(define *this-module* '())
|
||||
(define *load-path* (list "./lib" (string-append *module-directory* "/lib")))
|
||||
|
||||
(define (make-module exports env meta) (vector exports env meta))
|
||||
(define (module-exports mod) (vector-ref mod 0))
|
||||
|
|
@ -12,12 +11,6 @@
|
|||
(define (module-meta-data mod) (vector-ref mod 2))
|
||||
(define (module-env-set! mod env) (vector-set! mod 1 env))
|
||||
|
||||
(define (find-module-file name file)
|
||||
(let lp ((ls *load-path*))
|
||||
(and (pair? ls)
|
||||
(let ((path (string-append (car ls) "/" file)))
|
||||
(if (file-exists? path) path (lp (cdr ls)))))))
|
||||
|
||||
(define (module-name->strings ls res)
|
||||
(if (null? ls)
|
||||
res
|
||||
|
|
@ -36,7 +29,7 @@
|
|||
|
||||
(define (load-module-definition name)
|
||||
(let* ((file (module-name->file name))
|
||||
(path (find-module-file name file)))
|
||||
(path (find-module-file file)))
|
||||
(if path (load path *config-env*))))
|
||||
|
||||
(define (find-module name)
|
||||
|
|
@ -109,7 +102,7 @@
|
|||
dir f
|
||||
(if (eq? (car x) 'include) "" *shared-object-extension*))))
|
||||
(cond
|
||||
((find-module-file name f) => (lambda (x) (load x env)))
|
||||
((find-module-file f) => (lambda (x) (load x env)))
|
||||
(else (error "couldn't find include" f)))))
|
||||
(cdr x)))
|
||||
((body)
|
||||
|
|
|
|||
144
eval.c
144
eval.c
|
|
@ -7,7 +7,6 @@
|
|||
/************************************************************************/
|
||||
|
||||
static int scheme_initialized_p = 0;
|
||||
char *sexp_module_dir = NULL;
|
||||
|
||||
#if SEXP_USE_DEBUG
|
||||
#include "opt/debug.c"
|
||||
|
|
@ -19,6 +18,8 @@ char *sexp_module_dir = NULL;
|
|||
|
||||
static sexp analyze (sexp ctx, sexp x);
|
||||
static void generate (sexp ctx, sexp x);
|
||||
static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env);
|
||||
static sexp sexp_find_module_file_op (sexp ctx, sexp file);
|
||||
|
||||
static sexp sexp_compile_error (sexp ctx, char *message, sexp obj) {
|
||||
sexp exn;
|
||||
|
|
@ -273,20 +274,41 @@ static sexp sexp_make_lit (sexp ctx, sexp value) {
|
|||
|
||||
#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*SEXP_INIT_STACK_SIZE)
|
||||
|
||||
static void sexp_add_path (sexp ctx, char *str) {
|
||||
char *colon;
|
||||
if (str && *str) {
|
||||
colon = strchr(str, ':');
|
||||
if (colon)
|
||||
sexp_add_path(ctx, colon+1);
|
||||
else
|
||||
colon = str + strlen(str);
|
||||
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), SEXP_VOID);
|
||||
sexp_car(sexp_global(ctx, SEXP_G_MODULE_PATH))
|
||||
= sexp_c_string(ctx, str, colon-str);
|
||||
}
|
||||
}
|
||||
|
||||
void sexp_init_eval_context_globals (sexp ctx) {
|
||||
sexp_gc_var2(bc, vec);
|
||||
sexp_gc_var2(tmp, vec);
|
||||
ctx = sexp_make_child_context(ctx, NULL);
|
||||
sexp_gc_preserve2(ctx, bc, vec);
|
||||
sexp_gc_preserve2(ctx, tmp, vec);
|
||||
emit(ctx, SEXP_OP_RESUMECC);
|
||||
sexp_global(ctx, SEXP_G_RESUMECC_BYTECODE) = finalize_bytecode(ctx);
|
||||
ctx = sexp_make_child_context(ctx, NULL);
|
||||
emit(ctx, SEXP_OP_DONE);
|
||||
bc = finalize_bytecode(ctx);
|
||||
tmp = finalize_bytecode(ctx);
|
||||
vec = sexp_make_vector(ctx, 0, SEXP_VOID);
|
||||
sexp_global(ctx, SEXP_G_FINAL_RESUMER)
|
||||
= sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, bc, vec);
|
||||
= sexp_make_procedure(ctx, SEXP_ZERO, SEXP_ZERO, tmp, vec);
|
||||
sexp_bytecode_name(sexp_procedure_code(sexp_global(ctx, SEXP_G_FINAL_RESUMER)))
|
||||
= sexp_intern(ctx, "final-resumer");
|
||||
sexp_global(ctx, SEXP_G_MODULE_PATH) = SEXP_NULL;
|
||||
sexp_add_path(ctx, sexp_default_module_dir);
|
||||
sexp_add_path(ctx, getenv(SEXP_MODULE_PATH_VAR));
|
||||
tmp = sexp_c_string(ctx, "./lib", 5);
|
||||
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), tmp);
|
||||
tmp = sexp_c_string(ctx, ".", 1);
|
||||
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), tmp);
|
||||
sexp_gc_release2(ctx);
|
||||
}
|
||||
|
||||
|
|
@ -2371,68 +2393,90 @@ sexp sexp_make_primitive_env (sexp ctx, sexp version) {
|
|||
return e;
|
||||
}
|
||||
|
||||
sexp sexp_find_module_file (sexp ctx, char *file) {
|
||||
sexp res=SEXP_FALSE, ls;
|
||||
char *dir, *path;
|
||||
sexp_uint_t slash, dirlen, filelen, len;
|
||||
#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
|
||||
#define file_exists_p(path, buf) (! stat(path, buf))
|
||||
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;
|
||||
filelen = strlen(file);
|
||||
|
||||
ls = sexp_global(ctx, SEXP_G_MODULE_PATH);
|
||||
for ( ; sexp_pairp(ls) && sexp_not(res); ls=sexp_cdr(ls)) {
|
||||
dir = sexp_string_data(sexp_car(ls));
|
||||
dirlen = sexp_string_length(sexp_car(ls));
|
||||
slash = dir[dirlen-1] == '/';
|
||||
len = dirlen+filelen+2-slash;
|
||||
path = (char*) malloc(len);
|
||||
memcpy(path, dir, dirlen);
|
||||
if (! slash) path[dirlen] = '/';
|
||||
memcpy(path+len-filelen-1, file, filelen);
|
||||
path[len-1] = '\0';
|
||||
if (file_exists_p(path, buf))
|
||||
res = sexp_c_string(ctx, path, len-1);
|
||||
free(path);
|
||||
}
|
||||
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"
|
||||
static sexp sexp_find_module_file_op (sexp ctx, sexp file) {
|
||||
if (! sexp_stringp(file))
|
||||
return sexp_type_exception(ctx, "not a string", file);
|
||||
else
|
||||
return sexp_find_module_file(ctx, sexp_string_data(file));
|
||||
}
|
||||
|
||||
#define sexp_file_not_found "couldn't find file in module path"
|
||||
|
||||
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);
|
||||
sexp res;
|
||||
sexp_gc_var1(path);
|
||||
sexp_gc_preserve1(ctx, path);
|
||||
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 {
|
||||
if (sexp_stringp(path)) {
|
||||
res = sexp_load(ctx, path, env);
|
||||
} else {
|
||||
path = sexp_c_string(ctx, file, -1);
|
||||
res = sexp_user_exception(ctx, SEXP_FALSE, sexp_file_not_found, path);
|
||||
}
|
||||
sexp_gc_release2(ctx);
|
||||
sexp_gc_release1(ctx);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) {
|
||||
if (! sexp_stringp(file))
|
||||
return sexp_type_exception(ctx, "not a string", file);
|
||||
else if (! sexp_envp(env))
|
||||
return sexp_type_exception(ctx, "not an environment", env);
|
||||
return sexp_load_module_file(ctx, sexp_string_data(file), env);
|
||||
}
|
||||
|
||||
sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp) {
|
||||
sexp ls;
|
||||
if (! sexp_stringp(dir))
|
||||
return sexp_type_exception(ctx, "not a string", dir);
|
||||
if (sexp_truep(appendp)) {
|
||||
if (sexp_pairp(ls=sexp_global(ctx, SEXP_G_MODULE_PATH))) {
|
||||
for ( ; sexp_pairp(sexp_cdr(ls)); ls=sexp_cdr(ls))
|
||||
;
|
||||
sexp_cdr(ls) = sexp_list1(ctx, dir);
|
||||
} else {
|
||||
sexp_global(ctx, SEXP_G_MODULE_PATH) = sexp_list1(ctx, dir);
|
||||
}
|
||||
} else {
|
||||
sexp_push(ctx, sexp_global(ctx, SEXP_G_MODULE_PATH), dir);
|
||||
}
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
||||
sexp_gc_var3(op, tmp, sym);
|
||||
sexp_gc_preserve3(ctx, op, tmp, sym);
|
||||
|
|
@ -2444,8 +2488,6 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, 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, 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));
|
||||
|
|
@ -2471,7 +2513,9 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
|||
if (! sexp_exceptionp(tmp)) {
|
||||
sexp_global(ctx, SEXP_G_CONFIG_ENV) = tmp;
|
||||
sexp_env_copy(ctx, tmp, e, SEXP_FALSE);
|
||||
sexp_load_module_file(ctx, sexp_config_file, tmp);
|
||||
op = sexp_load_module_file(ctx, sexp_config_file, tmp);
|
||||
if (sexp_exceptionp(op))
|
||||
sexp_print_exception(ctx, op, sexp_current_error_port(ctx));
|
||||
sexp_env_define(ctx, tmp, sym, tmp);
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -15,8 +15,6 @@
|
|||
#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,
|
||||
|
|
@ -135,7 +133,9 @@ 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_find_module_file (sexp ctx, char *file);
|
||||
SEXP_API sexp sexp_load_module_file (sexp ctx, char *file, sexp env);
|
||||
SEXP_API sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp);
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -5,6 +5,8 @@
|
|||
#ifndef SEXP_H
|
||||
#define SEXP_H
|
||||
|
||||
#define SEXP_MODULE_PATH_VAR "CHIBI_MODULE_PATH"
|
||||
|
||||
#include "chibi/config.h"
|
||||
#include "chibi/install.h"
|
||||
|
||||
|
|
@ -686,6 +688,7 @@ enum sexp_context_globals {
|
|||
SEXP_G_OOS_ERROR, /* out of stack exception object */
|
||||
SEXP_G_OPTIMIZATIONS,
|
||||
SEXP_G_CONFIG_ENV,
|
||||
SEXP_G_MODULE_PATH,
|
||||
SEXP_G_QUOTE_SYMBOL,
|
||||
SEXP_G_QUASIQUOTE_SYMBOL,
|
||||
SEXP_G_UNQUOTE_SYMBOL,
|
||||
|
|
|
|||
49
main.c
49
main.c
|
|
@ -7,6 +7,9 @@
|
|||
#define sexp_argv_symbol "*command-line-arguments*"
|
||||
#define sexp_argv_proc "(define (command-line-arguments) "sexp_argv_symbol")"
|
||||
|
||||
#define sexp_import_prefix "(import ("
|
||||
#define sexp_import_suffix "))"
|
||||
|
||||
static void repl (sexp ctx) {
|
||||
sexp in, out, err;
|
||||
sexp_gc_var4(obj, tmp, res, env);
|
||||
|
|
@ -57,9 +60,12 @@ static sexp check_exception (sexp ctx, sexp res) {
|
|||
return res;
|
||||
}
|
||||
|
||||
#define sexp_load_init() if (! init_loaded++) check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE))
|
||||
|
||||
void run_main (int argc, char **argv) {
|
||||
char *arg, *impmod, *p;
|
||||
sexp env, out=NULL, res=SEXP_VOID, ctx;
|
||||
sexp_sint_t i, quit=0, init_loaded=0;
|
||||
sexp_sint_t i, len, quit=0, print=0, init_loaded=0;
|
||||
sexp_gc_var2(str, args);
|
||||
|
||||
ctx = sexp_make_eval_context(NULL, NULL, NULL);
|
||||
|
|
@ -73,29 +79,49 @@ void run_main (int argc, char **argv) {
|
|||
switch (argv[i][1]) {
|
||||
case 'e':
|
||||
case 'p':
|
||||
if (! init_loaded++)
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
res = check_exception(ctx, sexp_read_from_string(ctx, argv[i+1]));
|
||||
print = (argv[i][1] == 'p');
|
||||
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
|
||||
sexp_load_init();
|
||||
res = check_exception(ctx, sexp_read_from_string(ctx, arg));
|
||||
res = check_exception(ctx, sexp_eval(ctx, res, env));
|
||||
if (argv[i][1] == 'p') {
|
||||
if (print) {
|
||||
if (! sexp_oportp(out))
|
||||
out = sexp_eval_string(ctx, "(current-output-port)", env);
|
||||
sexp_write(ctx, res, out);
|
||||
sexp_write_char(ctx, '\n', out);
|
||||
}
|
||||
quit=1;
|
||||
quit = 1;
|
||||
i++;
|
||||
break;
|
||||
case 'l':
|
||||
if (! init_loaded++)
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
|
||||
sexp_load_init();
|
||||
check_exception(ctx, sexp_load_module_file(ctx, argv[++i], env));
|
||||
break;
|
||||
case 'u':
|
||||
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
|
||||
sexp_load_init();
|
||||
len = strlen(arg)+strlen(sexp_import_prefix)+strlen(sexp_import_suffix);
|
||||
impmod = (char*) malloc(len+1);
|
||||
strcpy(impmod, sexp_import_prefix);
|
||||
strcpy(impmod+strlen(sexp_import_prefix), arg);
|
||||
strcpy(impmod+len-+strlen(sexp_import_suffix), sexp_import_suffix);
|
||||
impmod[len] = '\0';
|
||||
for (p=impmod; *p; p++)
|
||||
if (*p == '.') *p=' ';
|
||||
check_exception(ctx, sexp_eval_string(ctx, impmod, env));
|
||||
free(impmod);
|
||||
break;
|
||||
case 'q':
|
||||
init_loaded = 1;
|
||||
break;
|
||||
case 'm':
|
||||
sexp_module_dir = argv[++i];
|
||||
case 'A':
|
||||
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
|
||||
sexp_add_module_directory(ctx, str=sexp_c_string(ctx,arg,-1), SEXP_TRUE);
|
||||
break;
|
||||
case 'I':
|
||||
arg = ((argv[i][2] == '\0') ? argv[++i] : argv[i]+2);
|
||||
sexp_add_module_directory(ctx, str=sexp_c_string(ctx,arg,-1), SEXP_FALSE);
|
||||
break;
|
||||
case 's':
|
||||
for (argc=argc-1; argc>i+1; argc--)
|
||||
|
|
@ -108,8 +134,7 @@ void run_main (int argc, char **argv) {
|
|||
}
|
||||
|
||||
if (! quit) {
|
||||
if (! init_loaded)
|
||||
check_exception(ctx, sexp_load_standard_env(ctx, env, SEXP_FIVE));
|
||||
sexp_load_init();
|
||||
sexp_env_define(ctx, env, sexp_intern(ctx, sexp_argv_symbol), args);
|
||||
sexp_eval_string(ctx, sexp_argv_proc, env);
|
||||
if (i < argc)
|
||||
|
|
|
|||
|
|
@ -143,5 +143,10 @@ _FN2OPTP(SEXP_PROCEDURE, SEXP_OPORT, "disasm", (sexp)"*current-error-port*", sex
|
|||
#include "opt/plan9-opcodes.c"
|
||||
#endif
|
||||
_FN1(SEXP_STRING, "file-exists?", 0, sexp_file_exists_p),
|
||||
#if SEXP_USE_MODULES
|
||||
_FN1(SEXP_STRING, "find-module-file", 0, sexp_find_module_file_op),
|
||||
_FN2(SEXP_STRING, SEXP_ENV, "load-module-file", 0, sexp_load_module_file_op),
|
||||
_FN2(SEXP_STRING, SEXP_BOOLEAN, "add-module-directory", 0, sexp_add_module_directory),
|
||||
#endif
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue