pic_senv -> pic_env
This commit is contained in:
parent
d0e10b49a7
commit
599d8f5980
|
@ -402,14 +402,14 @@ gc_mark_object(pic_state *pic, struct pic_object *obj)
|
||||||
case PIC_TT_BLOB: {
|
case PIC_TT_BLOB: {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_SENV: {
|
case PIC_TT_ENV: {
|
||||||
struct pic_senv *senv = (struct pic_senv *)obj;
|
struct pic_env *env = (struct pic_env *)obj;
|
||||||
|
|
||||||
if (senv->up) {
|
if (env->up) {
|
||||||
gc_mark_object(pic, (struct pic_object *)senv->up);
|
gc_mark_object(pic, (struct pic_object *)env->up);
|
||||||
}
|
}
|
||||||
gc_mark(pic, senv->defer);
|
gc_mark(pic, env->defer);
|
||||||
gc_mark_object(pic, (struct pic_object *)senv->map);
|
gc_mark_object(pic, (struct pic_object *)env->map);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_LIB: {
|
case PIC_TT_LIB: {
|
||||||
|
@ -643,7 +643,7 @@ gc_finalize_object(pic_state *pic, struct pic_object *obj)
|
||||||
case PIC_TT_ERROR: {
|
case PIC_TT_ERROR: {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_SENV: {
|
case PIC_TT_ENV: {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case PIC_TT_LIB: {
|
case PIC_TT_LIB: {
|
||||||
|
|
|
@ -12,7 +12,7 @@ extern "C" {
|
||||||
struct pic_lib {
|
struct pic_lib {
|
||||||
PIC_OBJECT_HEADER
|
PIC_OBJECT_HEADER
|
||||||
pic_value name;
|
pic_value name;
|
||||||
struct pic_senv *env;
|
struct pic_env *env;
|
||||||
struct pic_dict *exports;
|
struct pic_dict *exports;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|
|
@ -9,28 +9,28 @@
|
||||||
extern "C" {
|
extern "C" {
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
struct pic_senv {
|
struct pic_env {
|
||||||
PIC_OBJECT_HEADER
|
PIC_OBJECT_HEADER
|
||||||
struct pic_dict *map;
|
struct pic_dict *map;
|
||||||
pic_value defer;
|
pic_value defer;
|
||||||
struct pic_senv *up;
|
struct pic_env *up;
|
||||||
};
|
};
|
||||||
|
|
||||||
#define pic_senv_p(v) (pic_type(v) == PIC_TT_SENV)
|
#define pic_env_p(v) (pic_type(v) == PIC_TT_ENV)
|
||||||
#define pic_senv_ptr(v) ((struct pic_senv *)pic_ptr(v))
|
#define pic_env_ptr(v) ((struct pic_env *)pic_ptr(v))
|
||||||
|
|
||||||
struct pic_senv *pic_null_syntactic_environment(pic_state *);
|
struct pic_env *pic_null_syntactic_environment(pic_state *);
|
||||||
|
|
||||||
bool pic_identifier_p(pic_state *pic, pic_value obj);
|
bool pic_identifier_p(pic_state *pic, pic_value obj);
|
||||||
bool pic_identifier_eq_p(pic_state *, struct pic_senv *, pic_sym *, struct pic_senv *, pic_sym *);
|
bool pic_identifier_eq_p(pic_state *, struct pic_env *, pic_sym *, struct pic_env *, pic_sym *);
|
||||||
|
|
||||||
struct pic_senv *pic_make_senv(pic_state *, struct pic_senv *);
|
struct pic_env *pic_make_env(pic_state *, struct pic_env *);
|
||||||
|
|
||||||
pic_sym *pic_add_rename(pic_state *, struct pic_senv *, pic_sym *);
|
pic_sym *pic_add_rename(pic_state *, struct pic_env *, pic_sym *);
|
||||||
bool pic_find_rename(pic_state *, struct pic_senv *, pic_sym *, pic_sym ** /* = NULL */);
|
bool pic_find_rename(pic_state *, struct pic_env *, pic_sym *, pic_sym ** /* = NULL */);
|
||||||
void pic_put_rename(pic_state *, struct pic_senv *, pic_sym *, pic_sym *);
|
void pic_put_rename(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
|
||||||
|
|
||||||
void pic_define_syntactic_keyword(pic_state *, struct pic_senv *, pic_sym *, pic_sym *);
|
void pic_define_syntactic_keyword(pic_state *, struct pic_env *, pic_sym *, pic_sym *);
|
||||||
|
|
||||||
#if defined(__cplusplus)
|
#if defined(__cplusplus)
|
||||||
}
|
}
|
||||||
|
|
|
@ -156,7 +156,7 @@ enum pic_tt {
|
||||||
PIC_TT_PORT,
|
PIC_TT_PORT,
|
||||||
PIC_TT_ERROR,
|
PIC_TT_ERROR,
|
||||||
PIC_TT_CXT,
|
PIC_TT_CXT,
|
||||||
PIC_TT_SENV,
|
PIC_TT_ENV,
|
||||||
PIC_TT_LIB,
|
PIC_TT_LIB,
|
||||||
PIC_TT_IREP,
|
PIC_TT_IREP,
|
||||||
PIC_TT_DATA,
|
PIC_TT_DATA,
|
||||||
|
@ -310,8 +310,8 @@ pic_type_repr(enum pic_tt tt)
|
||||||
return "cxt";
|
return "cxt";
|
||||||
case PIC_TT_PROC:
|
case PIC_TT_PROC:
|
||||||
return "proc";
|
return "proc";
|
||||||
case PIC_TT_SENV:
|
case PIC_TT_ENV:
|
||||||
return "senv";
|
return "env";
|
||||||
case PIC_TT_LIB:
|
case PIC_TT_LIB:
|
||||||
return "lib";
|
return "lib";
|
||||||
case PIC_TT_IREP:
|
case PIC_TT_IREP:
|
||||||
|
|
|
@ -8,7 +8,7 @@ struct pic_lib *
|
||||||
pic_open_library(pic_state *pic, pic_value name)
|
pic_open_library(pic_state *pic, pic_value name)
|
||||||
{
|
{
|
||||||
struct pic_lib *lib;
|
struct pic_lib *lib;
|
||||||
struct pic_senv *senv;
|
struct pic_env *env;
|
||||||
struct pic_dict *exports;
|
struct pic_dict *exports;
|
||||||
|
|
||||||
if ((lib = pic_find_library(pic, name)) != NULL) {
|
if ((lib = pic_find_library(pic, name)) != NULL) {
|
||||||
|
@ -22,12 +22,12 @@ pic_open_library(pic_state *pic, pic_value name)
|
||||||
return lib;
|
return lib;
|
||||||
}
|
}
|
||||||
|
|
||||||
senv = pic_null_syntactic_environment(pic);
|
env = pic_null_syntactic_environment(pic);
|
||||||
exports = pic_make_dict(pic);
|
exports = pic_make_dict(pic);
|
||||||
|
|
||||||
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
|
lib = (struct pic_lib *)pic_obj_alloc(pic, sizeof(struct pic_lib), PIC_TT_LIB);
|
||||||
lib->name = name;
|
lib->name = name;
|
||||||
lib->env = senv;
|
lib->env = env;
|
||||||
lib->exports = exports;
|
lib->exports = exports;
|
||||||
|
|
||||||
/* register! */
|
/* register! */
|
||||||
|
|
|
@ -5,29 +5,29 @@
|
||||||
#include "picrin.h"
|
#include "picrin.h"
|
||||||
|
|
||||||
pic_sym *
|
pic_sym *
|
||||||
pic_add_rename(pic_state *pic, struct pic_senv *senv, pic_sym *sym)
|
pic_add_rename(pic_state *pic, struct pic_env *env, pic_sym *sym)
|
||||||
{
|
{
|
||||||
pic_sym *rename;
|
pic_sym *rename;
|
||||||
|
|
||||||
rename = pic_gensym(pic, sym);
|
rename = pic_gensym(pic, sym);
|
||||||
pic_put_rename(pic, senv, sym, rename);
|
pic_put_rename(pic, env, sym, rename);
|
||||||
return rename;
|
return rename;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_put_rename(pic_state *pic, struct pic_senv *senv, pic_sym *sym, pic_sym *rename)
|
pic_put_rename(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym *rename)
|
||||||
{
|
{
|
||||||
pic_dict_set(pic, senv->map, sym, pic_obj_value(rename));
|
pic_dict_set(pic, env->map, sym, pic_obj_value(rename));
|
||||||
}
|
}
|
||||||
|
|
||||||
bool
|
bool
|
||||||
pic_find_rename(pic_state *pic, struct pic_senv *senv, pic_sym *sym, pic_sym **rename)
|
pic_find_rename(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym **rename)
|
||||||
{
|
{
|
||||||
if (! pic_dict_has(pic, senv->map, sym)) {
|
if (! pic_dict_has(pic, env->map, sym)) {
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
if (rename != NULL) {
|
if (rename != NULL) {
|
||||||
*rename = pic_sym_ptr(pic_dict_ref(pic, senv->map, sym));
|
*rename = pic_sym_ptr(pic_dict_ref(pic, env->map, sym));
|
||||||
}
|
}
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
@ -48,17 +48,17 @@ find_macro(pic_state *pic, pic_sym *rename)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_sym *
|
static pic_sym *
|
||||||
make_identifier(pic_state *pic, pic_sym *sym, struct pic_senv *senv)
|
make_identifier(pic_state *pic, pic_sym *sym, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_sym *rename;
|
pic_sym *rename;
|
||||||
|
|
||||||
while (true) {
|
while (true) {
|
||||||
if (pic_find_rename(pic, senv, sym, &rename)) {
|
if (pic_find_rename(pic, env, sym, &rename)) {
|
||||||
return rename;
|
return rename;
|
||||||
}
|
}
|
||||||
if (! senv->up)
|
if (! env->up)
|
||||||
break;
|
break;
|
||||||
senv = senv->up;
|
env = env->up;
|
||||||
}
|
}
|
||||||
if (! pic_interned_p(pic, sym)) {
|
if (! pic_interned_p(pic, sym)) {
|
||||||
return sym;
|
return sym;
|
||||||
|
@ -68,13 +68,13 @@ make_identifier(pic_state *pic, pic_sym *sym, struct pic_senv *senv)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value macroexpand(pic_state *, pic_value, struct pic_senv *);
|
static pic_value macroexpand(pic_state *, pic_value, struct pic_env *);
|
||||||
static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_senv *);
|
static pic_value macroexpand_lambda(pic_state *, pic_value, struct pic_env *);
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_symbol(pic_state *pic, pic_sym *sym, struct pic_senv *senv)
|
macroexpand_symbol(pic_state *pic, pic_sym *sym, struct pic_env *env)
|
||||||
{
|
{
|
||||||
return pic_obj_value(make_identifier(pic, sym, senv));
|
return pic_obj_value(make_identifier(pic, sym, env));
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
|
@ -84,17 +84,17 @@ macroexpand_quote(pic_state *pic, pic_value expr)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
|
macroexpand_list(pic_state *pic, pic_value obj, struct pic_env *env)
|
||||||
{
|
{
|
||||||
size_t ai = pic_gc_arena_preserve(pic);
|
size_t ai = pic_gc_arena_preserve(pic);
|
||||||
pic_value x, head, tail;
|
pic_value x, head, tail;
|
||||||
|
|
||||||
if (pic_pair_p(obj)) {
|
if (pic_pair_p(obj)) {
|
||||||
head = macroexpand(pic, pic_car(pic, obj), senv);
|
head = macroexpand(pic, pic_car(pic, obj), env);
|
||||||
tail = macroexpand_list(pic, pic_cdr(pic, obj), senv);
|
tail = macroexpand_list(pic, pic_cdr(pic, obj), env);
|
||||||
x = pic_cons(pic, head, tail);
|
x = pic_cons(pic, head, tail);
|
||||||
} else {
|
} else {
|
||||||
x = macroexpand(pic, obj, senv);
|
x = macroexpand(pic, obj, env);
|
||||||
}
|
}
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
pic_gc_arena_restore(pic, ai);
|
||||||
|
@ -103,46 +103,46 @@ macroexpand_list(pic_state *pic, pic_value obj, struct pic_senv *senv)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_defer(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand_defer(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_value skel = pic_list1(pic, pic_none_value()); /* (#<none>) */
|
pic_value skel = pic_list1(pic, pic_none_value()); /* (#<none>) */
|
||||||
|
|
||||||
pic_push(pic, pic_cons(pic, expr, skel), senv->defer);
|
pic_push(pic, pic_cons(pic, expr, skel), env->defer);
|
||||||
|
|
||||||
return skel;
|
return skel;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void
|
||||||
macroexpand_deferred(pic_state *pic, struct pic_senv *senv)
|
macroexpand_deferred(pic_state *pic, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_value defer, val, src, dst, it;
|
pic_value defer, val, src, dst, it;
|
||||||
|
|
||||||
pic_for_each (defer, pic_reverse(pic, senv->defer), it) {
|
pic_for_each (defer, pic_reverse(pic, env->defer), it) {
|
||||||
src = pic_car(pic, defer);
|
src = pic_car(pic, defer);
|
||||||
dst = pic_cdr(pic, defer);
|
dst = pic_cdr(pic, defer);
|
||||||
|
|
||||||
val = macroexpand_lambda(pic, src, senv);
|
val = macroexpand_lambda(pic, src, env);
|
||||||
|
|
||||||
/* copy */
|
/* copy */
|
||||||
pic_pair_ptr(dst)->car = pic_car(pic, val);
|
pic_pair_ptr(dst)->car = pic_car(pic, val);
|
||||||
pic_pair_ptr(dst)->cdr = pic_cdr(pic, val);
|
pic_pair_ptr(dst)->cdr = pic_cdr(pic, val);
|
||||||
}
|
}
|
||||||
|
|
||||||
senv->defer = pic_nil_value();
|
env->defer = pic_nil_value();
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_value formal, body;
|
pic_value formal, body;
|
||||||
struct pic_senv *in;
|
struct pic_env *in;
|
||||||
pic_value a;
|
pic_value a;
|
||||||
|
|
||||||
if (pic_length(pic, expr) < 2) {
|
if (pic_length(pic, expr) < 2) {
|
||||||
pic_errorf(pic, "syntax error");
|
pic_errorf(pic, "syntax error");
|
||||||
}
|
}
|
||||||
|
|
||||||
in = pic_make_senv(pic, senv);
|
in = pic_make_env(pic, env);
|
||||||
|
|
||||||
for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
|
for (a = pic_cadr(pic, expr); pic_pair_p(a); a = pic_cdr(pic, a)) {
|
||||||
pic_value v = pic_car(pic, a);
|
pic_value v = pic_car(pic, a);
|
||||||
|
@ -168,7 +168,7 @@ macroexpand_lambda(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand_define(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_sym *sym, *rename;
|
pic_sym *sym, *rename;
|
||||||
pic_value var, val;
|
pic_value var, val;
|
||||||
|
@ -189,16 +189,16 @@ macroexpand_define(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
pic_errorf(pic, "binding to non-symbol object");
|
pic_errorf(pic, "binding to non-symbol object");
|
||||||
}
|
}
|
||||||
sym = pic_sym_ptr(var);
|
sym = pic_sym_ptr(var);
|
||||||
if (! pic_find_rename(pic, senv, sym, &rename)) {
|
if (! pic_find_rename(pic, env, sym, &rename)) {
|
||||||
rename = pic_add_rename(pic, senv, sym);
|
rename = pic_add_rename(pic, env, sym);
|
||||||
}
|
}
|
||||||
val = macroexpand(pic, pic_list_ref(pic, expr, 2), senv);
|
val = macroexpand(pic, pic_list_ref(pic, expr, 2), env);
|
||||||
|
|
||||||
return pic_list3(pic, pic_obj_value(pic->rDEFINE), pic_obj_value(rename), val);
|
return pic_list3(pic, pic_obj_value(pic->rDEFINE), pic_obj_value(rename), val);
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_value var, val;
|
pic_value var, val;
|
||||||
pic_sym *sym, *rename;
|
pic_sym *sym, *rename;
|
||||||
|
@ -212,8 +212,8 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
pic_errorf(pic, "binding to non-symbol object");
|
pic_errorf(pic, "binding to non-symbol object");
|
||||||
}
|
}
|
||||||
sym = pic_sym_ptr(var);
|
sym = pic_sym_ptr(var);
|
||||||
if (! pic_find_rename(pic, senv, sym, &rename)) {
|
if (! pic_find_rename(pic, env, sym, &rename)) {
|
||||||
rename = pic_add_rename(pic, senv, sym);
|
rename = pic_add_rename(pic, env, sym);
|
||||||
} else {
|
} else {
|
||||||
pic_warnf(pic, "redefining syntax variable: ~s", pic_obj_value(sym));
|
pic_warnf(pic, "redefining syntax variable: ~s", pic_obj_value(sym));
|
||||||
}
|
}
|
||||||
|
@ -230,7 +230,7 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
|
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
|
||||||
}
|
}
|
||||||
|
|
||||||
val = pic_apply1(pic, pic_proc_ptr(val), pic_obj_value(senv));
|
val = pic_apply1(pic, pic_proc_ptr(val), pic_obj_value(env));
|
||||||
|
|
||||||
if (! pic_proc_p(val)) {
|
if (! pic_proc_p(val)) {
|
||||||
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
|
pic_errorf(pic, "macro definition \"~s\" evaluates to non-procedure object", var);
|
||||||
|
@ -242,7 +242,7 @@ macroexpand_defsyntax(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct pic_senv *senv)
|
macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
pic_value v, args;
|
pic_value v, args;
|
||||||
|
|
||||||
|
@ -252,7 +252,7 @@ macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct p
|
||||||
puts("");
|
puts("");
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
args = pic_list2(pic, expr, pic_obj_value(senv));
|
args = pic_list2(pic, expr, pic_obj_value(env));
|
||||||
|
|
||||||
pic_try {
|
pic_try {
|
||||||
v = pic_apply(pic, mac, args);
|
v = pic_apply(pic, mac, args);
|
||||||
|
@ -270,11 +270,11 @@ macroexpand_macro(pic_state *pic, struct pic_proc *mac, pic_value expr, struct p
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand_node(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
switch (pic_type(expr)) {
|
switch (pic_type(expr)) {
|
||||||
case PIC_TT_SYMBOL: {
|
case PIC_TT_SYMBOL: {
|
||||||
return macroexpand_symbol(pic, pic_sym_ptr(expr), senv);
|
return macroexpand_symbol(pic, pic_sym_ptr(expr), env);
|
||||||
}
|
}
|
||||||
case PIC_TT_PAIR: {
|
case PIC_TT_PAIR: {
|
||||||
pic_value car;
|
pic_value car;
|
||||||
|
@ -284,29 +284,29 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
pic_errorf(pic, "cannot macroexpand improper list: ~s", expr);
|
pic_errorf(pic, "cannot macroexpand improper list: ~s", expr);
|
||||||
}
|
}
|
||||||
|
|
||||||
car = macroexpand(pic, pic_car(pic, expr), senv);
|
car = macroexpand(pic, pic_car(pic, expr), env);
|
||||||
if (pic_sym_p(car)) {
|
if (pic_sym_p(car)) {
|
||||||
pic_sym *tag = pic_sym_ptr(car);
|
pic_sym *tag = pic_sym_ptr(car);
|
||||||
|
|
||||||
if (tag == pic->rDEFINE_SYNTAX) {
|
if (tag == pic->rDEFINE_SYNTAX) {
|
||||||
return macroexpand_defsyntax(pic, expr, senv);
|
return macroexpand_defsyntax(pic, expr, env);
|
||||||
}
|
}
|
||||||
else if (tag == pic->rLAMBDA) {
|
else if (tag == pic->rLAMBDA) {
|
||||||
return macroexpand_defer(pic, expr, senv);
|
return macroexpand_defer(pic, expr, env);
|
||||||
}
|
}
|
||||||
else if (tag == pic->rDEFINE) {
|
else if (tag == pic->rDEFINE) {
|
||||||
return macroexpand_define(pic, expr, senv);
|
return macroexpand_define(pic, expr, env);
|
||||||
}
|
}
|
||||||
else if (tag == pic->rQUOTE) {
|
else if (tag == pic->rQUOTE) {
|
||||||
return macroexpand_quote(pic, expr);
|
return macroexpand_quote(pic, expr);
|
||||||
}
|
}
|
||||||
|
|
||||||
if ((mac = find_macro(pic, tag)) != NULL) {
|
if ((mac = find_macro(pic, tag)) != NULL) {
|
||||||
return macroexpand_node(pic, macroexpand_macro(pic, mac, expr, senv), senv);
|
return macroexpand_node(pic, macroexpand_macro(pic, mac, expr, env), env);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), senv));
|
return pic_cons(pic, car, macroexpand_list(pic, pic_cdr(pic, expr), env));
|
||||||
}
|
}
|
||||||
default:
|
default:
|
||||||
return expr;
|
return expr;
|
||||||
|
@ -314,7 +314,7 @@ macroexpand_node(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
macroexpand(pic_state *pic, pic_value expr, struct pic_env *env)
|
||||||
{
|
{
|
||||||
size_t ai = pic_gc_arena_preserve(pic);
|
size_t ai = pic_gc_arena_preserve(pic);
|
||||||
pic_value v;
|
pic_value v;
|
||||||
|
@ -325,7 +325,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv)
|
||||||
puts("");
|
puts("");
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
v = macroexpand_node(pic, expr, senv);
|
v = macroexpand_node(pic, expr, env);
|
||||||
|
|
||||||
pic_gc_arena_restore(pic, ai);
|
pic_gc_arena_restore(pic, ai);
|
||||||
pic_gc_protect(pic, v);
|
pic_gc_protect(pic, v);
|
||||||
|
@ -365,44 +365,44 @@ pic_macroexpand(pic_state *pic, pic_value expr, struct pic_lib *lib)
|
||||||
return v;
|
return v;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct pic_senv *
|
struct pic_env *
|
||||||
pic_make_senv(pic_state *pic, struct pic_senv *up)
|
pic_make_env(pic_state *pic, struct pic_env *up)
|
||||||
{
|
{
|
||||||
struct pic_senv *senv;
|
struct pic_env *env;
|
||||||
struct pic_dict *map;
|
struct pic_dict *map;
|
||||||
|
|
||||||
map = pic_make_dict(pic);
|
map = pic_make_dict(pic);
|
||||||
|
|
||||||
senv = (struct pic_senv *)pic_obj_alloc(pic, sizeof(struct pic_senv), PIC_TT_SENV);
|
env = (struct pic_env *)pic_obj_alloc(pic, sizeof(struct pic_env), PIC_TT_ENV);
|
||||||
senv->up = up;
|
env->up = up;
|
||||||
senv->defer = pic_nil_value();
|
env->defer = pic_nil_value();
|
||||||
senv->map = map;
|
env->map = map;
|
||||||
|
|
||||||
return senv;
|
return env;
|
||||||
}
|
}
|
||||||
|
|
||||||
struct pic_senv *
|
struct pic_env *
|
||||||
pic_null_syntactic_environment(pic_state *pic)
|
pic_null_syntactic_environment(pic_state *pic)
|
||||||
{
|
{
|
||||||
struct pic_senv *senv;
|
struct pic_env *env;
|
||||||
|
|
||||||
senv = pic_make_senv(pic, NULL);
|
env = pic_make_env(pic, NULL);
|
||||||
|
|
||||||
pic_define_syntactic_keyword(pic, senv, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
|
pic_define_syntactic_keyword(pic, env, pic->sDEFINE_LIBRARY, pic->rDEFINE_LIBRARY);
|
||||||
pic_define_syntactic_keyword(pic, senv, pic->sIMPORT, pic->rIMPORT);
|
pic_define_syntactic_keyword(pic, env, pic->sIMPORT, pic->rIMPORT);
|
||||||
pic_define_syntactic_keyword(pic, senv, pic->sEXPORT, pic->rEXPORT);
|
pic_define_syntactic_keyword(pic, env, pic->sEXPORT, pic->rEXPORT);
|
||||||
pic_define_syntactic_keyword(pic, senv, pic->sIN_LIBRARY, pic->rIN_LIBRARY);
|
pic_define_syntactic_keyword(pic, env, pic->sIN_LIBRARY, pic->rIN_LIBRARY);
|
||||||
pic_define_syntactic_keyword(pic, senv, pic->sCOND_EXPAND, pic->rCOND_EXPAND);
|
pic_define_syntactic_keyword(pic, env, pic->sCOND_EXPAND, pic->rCOND_EXPAND);
|
||||||
|
|
||||||
return senv;
|
return env;
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_define_syntactic_keyword(pic_state *pic, struct pic_senv *senv, pic_sym *sym, pic_sym *rsym)
|
pic_define_syntactic_keyword(pic_state *pic, struct pic_env *env, pic_sym *sym, pic_sym *rsym)
|
||||||
{
|
{
|
||||||
pic_put_rename(pic, senv, sym, rsym);
|
pic_put_rename(pic, env, sym, rsym);
|
||||||
|
|
||||||
if (pic->lib && pic->lib->env == senv) {
|
if (pic->lib && pic->lib->env == env) {
|
||||||
pic_export(pic, sym);
|
pic_export(pic, sym);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -446,7 +446,7 @@ pic_identifier_p(pic_state *pic, pic_value obj)
|
||||||
}
|
}
|
||||||
|
|
||||||
bool
|
bool
|
||||||
pic_identifier_eq_p(pic_state *pic, struct pic_senv *env1, pic_sym *sym1, struct pic_senv *env2, pic_sym *sym2)
|
pic_identifier_eq_p(pic_state *pic, struct pic_env *env1, pic_sym *sym1, struct pic_env *env2, pic_sym *sym2)
|
||||||
{
|
{
|
||||||
pic_sym *a, *b;
|
pic_sym *a, *b;
|
||||||
|
|
||||||
|
@ -481,9 +481,9 @@ pic_macro_make_identifier(pic_state *pic)
|
||||||
|
|
||||||
pic_get_args(pic, "mo", &sym, &obj);
|
pic_get_args(pic, "mo", &sym, &obj);
|
||||||
|
|
||||||
pic_assert_type(pic, obj, senv);
|
pic_assert_type(pic, obj, env);
|
||||||
|
|
||||||
return pic_obj_value(make_identifier(pic, sym, pic_senv_ptr(obj)));
|
return pic_obj_value(make_identifier(pic, sym, pic_env_ptr(obj)));
|
||||||
}
|
}
|
||||||
|
|
||||||
static pic_value
|
static pic_value
|
||||||
|
@ -494,10 +494,10 @@ pic_macro_identifier_eq_p(pic_state *pic)
|
||||||
|
|
||||||
pic_get_args(pic, "omom", &env1, &sym1, &env2, &sym2);
|
pic_get_args(pic, "omom", &env1, &sym1, &env2, &sym2);
|
||||||
|
|
||||||
pic_assert_type(pic, env1, senv);
|
pic_assert_type(pic, env1, env);
|
||||||
pic_assert_type(pic, env2, senv);
|
pic_assert_type(pic, env2, env);
|
||||||
|
|
||||||
return pic_bool_value(pic_identifier_eq_p(pic, pic_senv_ptr(env1), sym1, pic_senv_ptr(env2), sym2));
|
return pic_bool_value(pic_identifier_eq_p(pic, pic_env_ptr(env1), sym1, pic_env_ptr(env2), sym2));
|
||||||
}
|
}
|
||||||
|
|
||||||
void
|
void
|
||||||
|
|
Loading…
Reference in New Issue