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

Cherry supports now a simply module system

parent c5cce2d8
......@@ -112,6 +112,7 @@ struct value {
#define string_size(STR) (strlen(STR) + 1)
const byte_t* string_dup(const byte_t* str);
const byte_t* string_concat(const byte_t* str, ...);
struct value* char_from_string(const byte_t* str);
struct value* string_from_string(const byte_t* str);
......@@ -160,6 +161,7 @@ struct value* list_reverse(struct value* value);
#define PARENT_FRAMES(env) TAIL(env)
struct value* environment(void);
struct value* env_toplevel_frame(struct value* env);
struct value* env_lookup(struct value* env, struct value* var);
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);
......@@ -241,9 +243,10 @@ extern struct value* symbol_import;
HEAD(TAIL(value))
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 cherry_print(FILE* out, struct value* value);
void cherry_println(FILE* out, struct value* value);
void failure(struct context* context, const char* format, ...);
......
......@@ -27,9 +27,77 @@ eval_values(struct value* env, struct value* args)
return cons(cherry_eval(env, HEAD(args)), eval_values(env, TAIL(args)));
}
void
import(struct value* env, struct value* module, struct value* alias)
{
struct value* toplevel_env = env_toplevel_frame(env);
struct value* module_env = cherry_load(module);
struct value* frame = HEAD(module_env);
if(alias == 0)
alias = module;
while(!IS_NULL(frame)) {
struct value* pair = HEAD(frame);
struct value* name = (utf8_compare(alias->symbol_value, "*") == 0)
? NTH(pair, 0)
: symbol(string_concat(alias->symbol_value, "/", NTH(pair, 0)->symbol_value, 0));
env_let(toplevel_env, name, NTH(pair, 1));
frame = TAIL(frame);
}
}
void
import_selective(struct value* env, struct value* module, struct value* symbols, struct value* alias)
{
struct value* toplevel_env = env_toplevel_frame(env);
struct value* module_env = cherry_load(module);
if(alias == 0)
alias = module;
while(!IS_NULL(symbols)) {
struct value* key = HEAD(symbols);
struct value* value = env_lookup(module_env, key);
struct value* name = (utf8_compare(alias->symbol_value, "*") == 0)
? key
: symbol(string_concat(alias->symbol_value, "/", key->symbol_value, 0));
env_let(toplevel_env, name, value);
symbols = TAIL(symbols);
}
}
static struct value*
eval_import(struct value* env, struct value* args)
{
if(IS_NULL(args) || (!IS_SYMBOL(HEAD(args)) && !IS_PAIR(HEAD(args))) || (!IS_NULL(TAIL(args)) && !IS_SYMBOL(HEAD(TAIL(args)))))
failure(0, "import macro is called with wrong arguments");
struct value* head = HEAD(args);
struct value* alias = TAIL(args);
struct value* module = 0;
struct value* symbols = 0;
if(IS_PAIR(head)) {
module = HEAD(head);
symbols = TAIL(head);
import_selective(env, module, symbols, IS_NULL(alias) ? 0 : HEAD(alias));
} else {
module = head;
import(env, module, IS_NULL(alias) ? 0 : HEAD(alias));
}
return True;
}
......
......@@ -163,6 +163,16 @@ env_let(struct value* env, struct value* var, struct value* val)
}
struct value*
env_toplevel_frame(struct value* env)
{
while(!IS_NULL(TAIL(env)))
env = TAIL(env);
return env;
}
static const byte_t*
get_text(const char* filename, const char* mode) {
FILE* file = fopen(filename, mode);
......@@ -1393,7 +1403,7 @@ environment(void)
proc_to_env(env, "exit", core_exit);
return env;
return EXTEND_ENV(env);
}
......@@ -20,6 +20,8 @@
#include <gc.h>
#include <assert.h>
#include <stdio.h>
// ----------------------------------------------------------------------------
// helper methods
// ----------------------------------------------------------------------------
......@@ -38,6 +40,32 @@ string_dup(const byte_t* str)
}
const byte_t*
string_concat(const byte_t* str, ...)
{
struct array* buffer = array_new(32);
const byte_t* arg = 0;
va_list args;
array_append(buffer, str, utf8_size(str));
va_start(args, str);
arg = va_arg(args, const byte_t*);
while(arg != 0) {
array_append(buffer, arg, utf8_size(arg));
arg = va_arg(args, const byte_t*);
}
va_end(args);
array_append(buffer, "\0", 1);
return string_dup(array_get(buffer, 0));
}
struct value*
value_dup(struct value* value)
{
......@@ -404,6 +432,16 @@ print_pair(FILE* out, struct value* value)
}
}
void
cherry_println(FILE* out, struct value* value)
{
cherry_print(out, value);
fprintf(out, "\n");
fflush(out);
}
void
cherry_print(FILE* out, struct value* value)
{
......
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