Commit c5cce2d8 authored by Chris Müller's avatar Chris Müller
Browse files

Refactor core base for module system

parent 5b31ed77
......@@ -33,48 +33,13 @@ print_usage(FILE* out, const char* prog) {
}
static const byte_t*
get_text(const char* filename, const char* mode) {
FILE* file = fopen(filename, mode);
size_t filesize;
if(!file)
return 0;
fseek(file, 0, SEEK_END);
filesize = ftell(file);
rewind(file);
byte_t* data = GC_MALLOC(filesize * sizeof(byte_t));
fread(data, sizeof(byte_t), filesize, file);
fclose(file);
return data;
}
static void
process_file(const char* filename, const byte_t* method, struct value* arguments)
process_module(struct value* module, struct value* arguments)
{
const byte_t* src = get_text(filename, "rb");
struct value* env = environment();
if(src == 0)
failure(0, "Could not load %s", filename);
struct context* c = context(src, filename, SUPRESS_COMMENTS);
struct value* exp = cherry_read(c);
while(exp != 0) {
cherry_eval(env, exp);
exp = cherry_read(c);
}
struct value* env = cherry_load(module);
if(!method)
method = "main";
struct value* main = cons(symbol(method), arguments);
struct value* main = cons(symbol("main"), arguments);
cherry_eval(env, main);
exit(EXIT_SUCCESS);
......@@ -105,33 +70,42 @@ start_repl(void)
}
static void
print_loadpath(void)
{
int i;
printf("Loadpath: \n");
for(i = 0; i < ptrarray_size(loadpath); ++i)
printf(" %s\n", (const char*) ptrarray_get(loadpath, i));
}
int
main(int argc, char** argv)
{
static struct option options[] = {
{"help", no_argument, 0, 'h'},
{"loadpath", optional_argument, 0, 'I'},
{"main", optional_argument, 0, 'M'}
{"loadpath", optional_argument, 0, 'I'}
};
initialize(0);
int ch;
const char* filename = 0;
struct value* main_module = 0;
const byte_t* method = 0;
struct ptrarray* load_path = ptrarray_new(4);
struct value* arguments = emptylist;
while( (ch = getopt_long(argc, argv, "hI:M:", options, 0)) != -1) {
loadpath = ptrarray_new(4);
while( (ch = getopt_long(argc, argv, "hI:", options, 0)) != -1) {
switch(ch) {
case 'h':
print_usage(stdout, argv[0]);
exit(EXIT_SUCCESS);
case 'I':
ptrarray_append(load_path, optarg);
break;
case 'M':
method = optarg;
ptrarray_append(loadpath, optarg);
break;
case '?':
print_usage(stderr, argv[0]);
......@@ -142,15 +116,19 @@ main(int argc, char** argv)
}
}
ptrarray_append(loadpath, ".");
if(optind < argc)
filename = argv[optind++];
main_module = symbol(argv[optind++]);
while(optind < argc) {
arguments = cons(string(argv[optind++]), arguments);
}
if(filename)
process_file(filename, method, list_reverse(arguments));
print_loadpath();
if(main_module)
process_module(main_module, list_reverse(arguments));
else
start_repl();
......
......@@ -25,6 +25,7 @@
struct context;
struct value;
struct ptrarray;
#define TRUE 1
#define FALSE 0
......@@ -164,8 +165,6 @@ struct value* env_set(struct value* env, struct value* var, struct value* val)
struct value* env_let(struct value* env, struct value* var, struct value* val);
const byte_t* from_loadpath(struct value* module);
struct value* add_to_loaded_modules(struct value* symbol, struct value* env);
struct value* get_loaded_module(struct value* symbol);
extern struct value* global_symbollist;
extern struct value* loaded_modules;
......@@ -186,6 +185,7 @@ extern struct value* symbol_cond;
extern struct value* symbol_match;
extern struct value* symbol_when;
extern struct value* symbol_else;
extern struct value* symbol_import;
// ----------------------------------------------------------------------------
......@@ -231,6 +231,9 @@ extern struct value* symbol_else;
#define IS_BEGIN(value) \
IS_TAGGED(value, symbol_begin)
#define IS_IMPORT(value) \
IS_TAGGED(value, symbol_import)
#define IS_APPLICATION(value) \
IS_PAIR(value)
......@@ -240,6 +243,7 @@ extern struct value* symbol_else;
struct value* cherry_eval(struct value* env, struct value* exp);
void cherry_print(FILE* out, struct value* value);
struct value* cherry_read(struct context* context);
struct value* cherry_load(struct value* module);
void failure(struct context* context, const char* format, ...);
......
......@@ -27,6 +27,12 @@ eval_values(struct value* env, struct value* args)
return cons(cherry_eval(env, HEAD(args)), eval_values(env, TAIL(args)));
}
static struct value*
eval_import(struct value* env, struct value* args)
{
return True;
}
struct value*
cherry_eval(struct value* env, struct value* value)
{
......@@ -41,6 +47,9 @@ tailcall:
} else if(IS_QUOTE(value))
return TEXT_OF_QUOTATION(value);
else if(IS_IMPORT(value))
return eval_import(env, TAIL(value));
else if(IS_LET(value))
return env_let(env, HEAD(TAIL(value)), cherry_eval(env, HEAD(TAIL(TAIL(value)))));
......
......@@ -25,6 +25,9 @@
// ----------------------------------------------------------------------------
struct value* global_symbollist;
struct value* loaded_modules;
struct ptrarray* loadpath;
struct value* emptylist;
struct value* True;
struct value* False;
......@@ -41,6 +44,7 @@ struct value* symbol_else;
struct value* symbol_quote;
struct value* symbol_loop;
struct value* symbol_begin;
struct value* symbol_import;
struct value* STDIN;
struct value* STDOUT;
......@@ -69,6 +73,7 @@ initialize(struct value* arguments)
TAIL(emptylist) = emptylist;
global_symbollist = emptylist;
loaded_modules = emptylist;
symbol_quote = symbol("quote");
symbol_define = symbol("define");
......@@ -81,6 +86,7 @@ initialize(struct value* arguments)
symbol_match = symbol("match");
symbol_when = symbol("when");
symbol_else = symbol("else");
symbol_import = symbol("import");
STDIN = port(stdin);
STDOUT = port(stdout);
......@@ -157,14 +163,73 @@ env_let(struct value* env, struct value* var, struct value* val)
}
static const byte_t*
get_text(const char* filename, const char* mode) {
FILE* file = fopen(filename, mode);
size_t filesize;
if(!file)
return 0;
fseek(file, 0, SEEK_END);
filesize = ftell(file);
rewind(file);
byte_t* data = GC_MALLOC(filesize * sizeof(byte_t));
fread(data, sizeof(byte_t), filesize, file);
fclose(file);
return data;
}
struct value*
cherry_load(struct value* module)
{
struct value* env = 0;
struct value* p = loaded_modules;
while(!IS_NULL(p)) {
struct value* pair = HEAD(p);
if(NTH(pair, 0) == module)
env = NTH(pair, 1);
p = TAIL(p);
}
if(!env) {
const byte_t* filename = from_loadpath(module);
const byte_t* src = get_text(filename, "rb");
if(src == 0)
failure(0, "Could not load %s", filename);
env = environment();
struct context* c = context(src, filename, SUPRESS_COMMENTS);
struct value* exp = cherry_read(c);
while(exp != 0) {
cherry_eval(env, exp);
exp = cherry_read(c);
}
loaded_modules = cons(tuple2(module, env), loaded_modules);
}
return env;
}
const byte_t*
from_loadpath(struct value* module)
{
size_t module_size = utf8_size(module->symbol_value);
byte_t* modulename = GC_MALLOC(sizeof(byte_t) * module_size);
byte_t* modulename = GC_MALLOC(sizeof(byte_t) * module_size + sizeof('\0'));
byte_t* p;
memcpy(modulename, module->symbol_value, module_size);
memcpy(modulename, module->symbol_value, module_size + sizeof('\0'));
for(p = modulename; p < modulename + module_size; ++p) {
if(*p == '.')
......@@ -174,19 +239,23 @@ from_loadpath(struct value* module)
size_t loadpath_size = ptrarray_size(loadpath);
size_t i;
for(i = 0; i < module_size; ++i) {
for(i = 0; i < ptrarray_size(loadpath); ++i) {
const byte_t* path = (const byte_t*) ptrarray_get(loadpath, i);
size_t path_size = utf8_size(path);
byte_t* full_path = GC_MALLOC(sizeof(byte_t) * (module_size + path_size + 2));
byte_t* full_path = GC_MALLOC(sizeof(byte_t) * (module_size + path_size + 16));
memcpy(full_path, path, path_size);
memcpy(full_path + path_size + 1, modulename, module_size);
memcpy(full_path + path_size + module_size + 1, ".cherry", 7);
full_path[path_size] = '/';
full_path[path_size + module_size + 1] = '\0';
full_path[path_size + module_size + 8] = '\0';
FILE* port = fopen(full_path, "rb");
printf("FILE: %s\n", full_path);
if(port) {
fclose(port);
return full_path;
......@@ -1117,6 +1186,28 @@ core_is_number(struct value* env, struct value* args)
return IS_FIXNUM(HEAD(args)) ? True : False;
}
struct value*
core_is_char(struct value* env, struct value* args)
{
if(IS_NULL(args))
return False;
return IS_CHAR(HEAD(args)) ? True : False;
}
struct value*
core_is_boolean(struct value* env, struct value* args)
{
if(IS_NULL(args))
return False;
return IS_BOOLEAN(HEAD(args)) ? True : False;
}
struct value*
core_number_to_string(struct value* env, struct value* args)
{
......@@ -1294,6 +1385,9 @@ environment(void)
proc_to_env(env, "string->number", core_string_to_number);
proc_to_env(env, "string->symbol", core_string_to_symbol);
proc_to_env(env, "boolean?", core_is_boolean);
proc_to_env(env, "char?", core_is_char);
proc_to_env(env, "symbol?", core_is_symbol);
proc_to_env(env, "symbol->string", core_symbol_to_string);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment