Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-22 07:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

lowercasing

Browse source
This commit is contained in:
Alex Shinn 2009-03-15 21:23:39 +09:00
parent caa9a104dd
commit 2c37e682ef
4 changed files with 225 additions and 242 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -3,7 +3,7 @@
all: chibi-scheme
CFLAGS=-g -fno-inline -Os
CFLAGS=-g -fno-inline -save-temps -Os
GC_OBJ=./gc/gc.a

291
eval.c
View file

@ -27,9 +27,9 @@ static sexp env_cell(sexp e, sexp key) {
sexp ls;
do {
for (ls=sexp_env_bindings(e); SEXP_PAIRP(ls); ls=SEXP_CDR(ls))
if (SEXP_CAAR(ls) == key)
return SEXP_CAR(ls);
for (ls=sexp_env_bindings(e); sexp_pairp(ls); ls=sexp_cdr(ls))
if (sexp_caar(ls) == key)
return sexp_car(ls);
e = sexp_env_parent(e);
} while (e);
@ -49,7 +49,7 @@ static int env_global_p (sexp e, sexp id) {
static void env_define(sexp e, sexp key, sexp value) {
sexp cell = env_cell(e, key);
if (cell) {
SEXP_CDR(cell) = value;
sexp_cdr(cell) = value;
} else {
sexp_env_bindings(e)
= sexp_cons(sexp_cons(key, value), sexp_env_bindings(e));
@ -62,24 +62,24 @@ static sexp extend_env_closure (sexp e, sexp fv, int offset) {
e2->tag = SEXP_ENV;
sexp_env_parent(e2) = e;
sexp_env_bindings(e2) = SEXP_NULL;
for (i=offset; SEXP_PAIRP(fv); fv = SEXP_CDR(fv), i--)
for (i=offset; sexp_pairp(fv); fv = sexp_cdr(fv), i--)
sexp_env_bindings(e2)
= sexp_cons(sexp_cons(SEXP_CAR(fv), sexp_make_integer(i)),
= sexp_cons(sexp_cons(sexp_car(fv), sexp_make_integer(i)),
sexp_env_bindings(e2));
return e2;
}
static int core_code (sexp e, sexp sym) {
sexp cell = env_cell(e, sym);
if (! cell || ! SEXP_COREP(SEXP_CDR(cell))) return 0;
return (sexp_core_code(SEXP_CDR(cell)));
if (! cell || ! sexp_corep(sexp_cdr(cell))) return 0;
return (sexp_core_code(sexp_cdr(cell)));
}
static sexp sexp_reverse_flatten_dot (sexp ls) {
sexp res;
for (res=SEXP_NULL; SEXP_PAIRP(ls); ls=SEXP_CDR(ls))
res = sexp_cons(SEXP_CAR(ls), res);
return (SEXP_NULLP(ls) ? res : sexp_cons(ls, res));
for (res=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls))
res = sexp_cons(sexp_car(ls), res);
return (sexp_nullp(ls) ? res : sexp_cons(ls, res));
}
static sexp sexp_flatten_dot (sexp ls) {
@ -180,37 +180,35 @@ void analyze(sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
sexp o1, o2, e2, cell;
loop:
if (SEXP_PAIRP(obj)) {
if (SEXP_SYMBOLP(SEXP_CAR(obj))) {
o1 = env_cell(e, SEXP_CAR(obj));
if (sexp_pairp(obj)) {
if (sexp_symbolp(sexp_car(obj))) {
o1 = env_cell(e, sexp_car(obj));
if (! o1) {
analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
return;
}
o1 = SEXP_CDR(o1);
if (SEXP_COREP(o1)) {
o1 = sexp_cdr(o1);
if (sexp_corep(o1)) {
switch (sexp_core_code(o1)) {
case CORE_LAMBDA:
analyze_lambda(SEXP_FALSE, SEXP_CADR(obj), SEXP_CDDR(obj),
analyze_lambda(SEXP_FALSE, sexp_cadr(obj), sexp_cddr(obj),
bc, i, e, params, fv, sv, d, tailp);
break;
case CORE_DEFINE_SYNTAX:
env_define(e, SEXP_CADR(obj),
sexp_make_macro(eval(SEXP_CADDR(obj), e), e));
env_define(e, sexp_cadr(obj),
sexp_make_macro(eval(sexp_caddr(obj), e), e));
emit_push(bc, i, SEXP_UNDEF);
(*d)++;
break;
case CORE_DEFINE:
if ((sexp_core_code(o1) == CORE_DEFINE)
&& SEXP_PAIRP(SEXP_CADR(obj))) {
o2 = SEXP_CAR(SEXP_CADR(obj));
analyze_lambda(SEXP_CAR(SEXP_CADR(obj)),
SEXP_CDR(SEXP_CADR(obj)),
SEXP_CDDR(obj),
&& sexp_pairp(sexp_cadr(obj))) {
o2 = sexp_car(sexp_cadr(obj));
analyze_lambda(sexp_caadr(obj), sexp_cdadr(obj), sexp_cddr(obj),
bc, i, e, params, fv, sv, d, 0);
} else {
o2 = SEXP_CADR(obj);
analyze(SEXP_CADDR(obj), bc, i, e, params, fv, sv, d, 0);
o2 = sexp_cadr(obj);
analyze(sexp_caddr(obj), bc, i, e, params, fv, sv, d, 0);
}
if (sexp_env_global_p(e)) {
emit(bc, i, OP_GLOBAL_SET);
@ -221,89 +219,87 @@ void analyze(sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
if (! o1)
errx(1, "define in bad position: %p", o2);
emit(bc, i, OP_STACK_SET);
emit_word(bc, i, sexp_unbox_integer(SEXP_CDR(o1)));
emit_word(bc, i, sexp_unbox_integer(sexp_cdr(o1)));
}
(*d)++;
break;
case CORE_SET:
analyze(SEXP_CADDR(obj), bc, i, e, params, fv, sv, d, 0);
if (sexp_list_index(sv, SEXP_CADR(obj)) >= 0) {
analyze_var_ref(SEXP_CADR(obj), bc, i, e, params, fv, SEXP_NULL, d);
analyze(sexp_caddr(obj), bc, i, e, params, fv, sv, d, 0);
if (sexp_list_index(sv, sexp_cadr(obj)) >= 0) {
analyze_var_ref(sexp_cadr(obj), bc, i, e, params, fv, SEXP_NULL, d);
emit(bc, i, OP_SET_CAR);
} else {
emit(bc, i, OP_GLOBAL_SET);
emit_word(bc, i, (sexp_uint_t) SEXP_CADR(obj));
emit_word(bc, i, (sexp_uint_t) sexp_cadr(obj));
emit_push(bc, i, SEXP_UNDEF);
}
break;
case CORE_BEGIN:
for (o2 = SEXP_CDR(obj); SEXP_PAIRP(o2); o2 = SEXP_CDR(o2)) {
if (SEXP_PAIRP(SEXP_CDR(o2))) {
analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0);
for (o2 = sexp_cdr(obj); sexp_pairp(o2); o2 = sexp_cdr(o2)) {
if (sexp_pairp(sexp_cdr(o2))) {
analyze(sexp_car(o2), bc, i, e, params, fv, sv, d, 0);
emit(bc, i, OP_DROP);
(*d)--;
} else
analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, tailp);
analyze(sexp_car(o2), bc, i, e, params, fv, sv, d, tailp);
}
break;
case CORE_IF:
analyze(SEXP_CADR(obj), bc, i, e, params, fv, sv, d, 0);
analyze(sexp_cadr(obj), bc, i, e, params, fv, sv, d, 0);
emit(bc, i, OP_JUMP_UNLESS); /* jumps if test fails */
(*d)--;
tmp1 = *i;
emit(bc, i, 0);
analyze(SEXP_CADDR(obj), bc, i, e, params, fv, sv, d, tailp);
analyze(sexp_caddr(obj), bc, i, e, params, fv, sv, d, tailp);
emit(bc, i, OP_JUMP);
(*d)--;
tmp2 = *i;
emit(bc, i, 0);
/* ((signed char*) (*bc)->data)[tmp1] = (*i)-tmp1; /\* patch *\/ */
((signed char*) sexp_bytecode_data(*bc))[tmp1] = (*i)-tmp1;
if (SEXP_PAIRP(SEXP_CDDDR(obj))) {
analyze(SEXP_CADDDR(obj), bc, i, e, params, fv, sv, d, tailp);
if (sexp_pairp(sexp_cdddr(obj))) {
analyze(sexp_cadddr(obj), bc, i, e, params, fv, sv, d, tailp);
} else {
emit_push(bc, i, SEXP_UNDEF);
(*d)++;
}
/* ((signed char*) (*bc)->data)[tmp2] = (*i)-tmp2; /\* patch *\/ */
((signed char*) sexp_bytecode_data(*bc))[tmp2] = (*i)-tmp2;
break;
case CORE_QUOTE:
emit_push(bc, i, SEXP_CADR(obj));
emit_push(bc, i, sexp_cadr(obj));
(*d)++;
break;
default:
errx(1, "unknown core form: %s", sexp_core_code(o1));
}
} else if (SEXP_OPCODEP(o1)) {
} else if (sexp_opcodep(o1)) {
analyze_opcode(o1, obj, bc, i, e, params, fv, sv, d, tailp);
} else if (SEXP_MACROP(o1)) {
} else if (sexp_macrop(o1)) {
obj = sexp_expand_macro(o1, obj, e);
goto loop;
} else {
/* general procedure call */
analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
}
} else if (SEXP_PAIRP(SEXP_CAR(obj))) {
} else if (sexp_pairp(sexp_car(obj))) {
#if USE_FAST_LET
o2 = env_cell(e, SEXP_CAAR(obj));
o2 = env_cell(e, sexp_caar(obj));
if (o2
&& SEXP_COREP(SEXP_CDR(o2))
&& sexp_corep(sexp_cdr(o2))
&& (sexp_core_code(o2) == CORE_LAMBDA)
&& sexp_listp(SEXP_CADR(SEXP_CAR(obj)))) {
&& sexp_listp(sexp_cadr(sexp_car(obj)))) {
/* let */
tmp1 = sexp_unbox_integer(sexp_length(SEXP_CADR(SEXP_CAR(obj))));
e2 = extend_env_closure(e, SEXP_CADR(SEXP_CAR(obj)), (*d)+(tmp1-1));
for (o2=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2))
analyze(SEXP_CAR(o2), bc, i, e, params, fv, sv, d, 0);
params = sexp_append(SEXP_CADR(SEXP_CAR(obj)), params);
for (o2=SEXP_CDDR(SEXP_CAR(obj)); SEXP_PAIRP(o2); o2=SEXP_CDR(o2)) {
if (SEXP_PAIRP(SEXP_CDR(o2))) {
analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, 0);
tmp1 = sexp_unbox_integer(sexp_length(sexp_cadar(obj)));
e2 = extend_env_closure(e, sexp_cadar(obj), (*d)+(tmp1-1));
for (o2=sexp_reverse(sexp_cdr(obj)); sexp_pairp(o2); o2=sexp_cdr(o2))
analyze(sexp_car(o2), bc, i, e, params, fv, sv, d, 0);
params = sexp_append(sexp_cadar(obj), params);
for (o2=sexp_cddar(obj); sexp_pairp(o2); o2=sexp_cdr(o2)) {
if (sexp_pairp(sexp_cdr(o2))) {
analyze(sexp_car(o2), bc, i, e2, params, fv, sv, d, 0);
emit(bc, i, OP_DROP);
(*d)--;
} else {
analyze(SEXP_CAR(o2), bc, i, e2, params, fv, sv, d, tailp);
analyze(sexp_car(o2), bc, i, e2, params, fv, sv, d, tailp);
}
}
emit(bc, i, OP_STACK_SET);
@ -316,9 +312,9 @@ void analyze(sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
/* computed application */
analyze_app(obj, bc, i, e, params, fv, sv, d, tailp);
} else {
errx(1, "invalid operator: %s", SEXP_CAR(obj));
errx(1, "invalid operator: %s", sexp_car(obj));
}
} else if (SEXP_SYMBOLP(obj)) {
} else if (sexp_symbolp(obj)) {
analyze_var_ref(obj, bc, i, e, params, fv, sv, d);
} else { /* literal */
emit_push(bc, i, obj);
@ -341,11 +337,11 @@ void analyze_opcode (sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
case OPC_CONSTRUCTOR:
case OPC_ACCESSOR:
case OPC_GENERIC:
tmp1 = sexp_unbox_integer(sexp_length(SEXP_CDR(obj)));
tmp1 = sexp_unbox_integer(sexp_length(sexp_cdr(obj)));
if (tmp1 == 0) {
errx(1, "opcode with no arguments: %s", sexp_opcode_name(op));
} else if (tmp1 == 1) {
analyze(SEXP_CADR(obj), bc, i, e, params, fv, sv, d, 0);
analyze(sexp_cadr(obj), bc, i, e, params, fv, sv, d, 0);
if (sexp_opcode_class(op) == OPC_ARITHMETIC_INV) {
emit(bc, i, sexp_opcode_inverse(op));
(*d)++;
@ -353,8 +349,8 @@ void analyze_opcode (sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
emit(bc, i, sexp_opcode_code(op));
}
} else {
for (o1=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1=SEXP_CDR(o1))
analyze(SEXP_CAR(o1), bc, i, e, params, fv, sv, d, 0);
for (o1=sexp_reverse(sexp_cdr(obj)); sexp_pairp(o1); o1=sexp_cdr(o1))
analyze(sexp_car(o1), bc, i, e, params, fv, sv, d, 0);
emit(bc, i, sexp_opcode_code(op));
(*d) -= (tmp1-1);
if (sexp_opcode_class(op) == OPC_ARITHMETIC)
@ -363,15 +359,15 @@ void analyze_opcode (sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
}
break;
case OPC_IO:
tmp1 = sexp_unbox_integer(sexp_length(SEXP_CDR(obj)));
tmp1 = sexp_unbox_integer(sexp_length(sexp_cdr(obj)));
if (tmp1 == sexp_opcode_num_args(op) && sexp_opcode_variadic_p(op)) {
emit(bc, i, OP_PARAMETER);
emit_word(bc, i, (sexp_uint_t) sexp_opcode_data(op));
(*d)++;
tmp1++;
}
for (o1=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1=SEXP_CDR(o1))
analyze(SEXP_CAR(o1), bc, i, e, params, fv, sv, d, 0);
for (o1=sexp_reverse(sexp_cdr(obj)); sexp_pairp(o1); o1=sexp_cdr(o1))
analyze(sexp_car(o1), bc, i, e, params, fv, sv, d, 0);
emit(bc, i, sexp_opcode_code(op));
(*d) -= (tmp1-1);
break;
@ -380,11 +376,11 @@ void analyze_opcode (sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
emit_word(bc, i, (sexp_uint_t) sexp_opcode_data(op));
break;
case OPC_FOREIGN:
for (o1=sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1=SEXP_CDR(o1))
analyze(SEXP_CAR(o1), bc, i, e, params, fv, sv, d, 0);
for (o1=sexp_reverse(sexp_cdr(obj)); sexp_pairp(o1); o1=sexp_cdr(o1))
analyze(sexp_car(o1), bc, i, e, params, fv, sv, d, 0);
emit_push(bc, i, sexp_opcode_data(op));
emit(bc, i, sexp_opcode_code(op));
(*d) -= (sexp_unbox_integer(sexp_length(SEXP_CDR(obj)))-1);
(*d) -= (sexp_unbox_integer(sexp_length(sexp_cdr(obj)))-1);
break;
default:
errx(1, "unknown opcode class: %d", sexp_opcode_class(op));
@ -402,9 +398,9 @@ void analyze_var_ref (sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
o1 = env_cell(e, obj);
fprintf(stderr, "compiling local ref: ");
sexp_write(obj, cur_error_port);
fprintf(stderr, " => %d\n", *d - sexp_unbox_integer(SEXP_CDR(o1)));
fprintf(stderr, " => %d\n", *d - sexp_unbox_integer(sexp_cdr(o1)));
emit(bc, i, OP_STACK_REF);
emit_word(bc, i, *d - sexp_unbox_integer(SEXP_CDR(o1)));
emit_word(bc, i, *d - sexp_unbox_integer(sexp_cdr(o1)));
} else if ((tmp = sexp_list_index(fv, obj)) >= 0) {
fprintf(stderr, "compiling closure ref: %p => %d\n", obj, tmp);
emit(bc, i, OP_CLOSURE_REF);
@ -416,7 +412,6 @@ void analyze_var_ref (sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
}
(*d)++;
if (sexp_list_index(sv, obj) >= 0) {
/* fprintf(stderr, "mutable variable, fetching CAR\n"); */
emit(bc, i, OP_CAR);
}
}
@ -424,15 +419,15 @@ void analyze_var_ref (sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
void analyze_app (sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp) {
sexp o1;
sexp_uint_t len = sexp_unbox_integer(sexp_length(SEXP_CDR(obj)));
sexp_uint_t len = sexp_unbox_integer(sexp_length(sexp_cdr(obj)));
/* push the arguments onto the stack */
for (o1 = sexp_reverse(SEXP_CDR(obj)); SEXP_PAIRP(o1); o1 = SEXP_CDR(o1)) {
analyze(SEXP_CAR(o1), bc, i, e, params, fv, sv, d, 0);
for (o1 = sexp_reverse(sexp_cdr(obj)); sexp_pairp(o1); o1 = sexp_cdr(o1)) {
analyze(sexp_car(o1), bc, i, e, params, fv, sv, d, 0);
}
/* push the operator onto the stack */
analyze(SEXP_CAR(obj), bc, i, e, params, fv, sv, d, 0);
analyze(sexp_car(obj), bc, i, e, params, fv, sv, d, 0);
/* maybe overwrite the current frame */
if (tailp) {
@ -450,24 +445,24 @@ void analyze_app (sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
sexp free_vars (sexp e, sexp formals, sexp obj, sexp fv) {
sexp o1;
if (SEXP_SYMBOLP(obj)) {
if (sexp_symbolp(obj)) {
if (env_global_p(e, obj)
|| (sexp_list_index(formals, obj) >= 0)
|| (sexp_list_index(fv, obj) >= 0))
return fv;
else
return sexp_cons(obj, fv);
} else if (SEXP_PAIRP(obj)) {
if (SEXP_SYMBOLP(SEXP_CAR(obj))) {
if ((o1 = env_cell(e, SEXP_CAR(obj)))
&& SEXP_COREP(o1)
&& (sexp_core_code(SEXP_CDR(o1)) == CORE_LAMBDA)) {
return free_vars(e, SEXP_CADR(obj), SEXP_CADDR(obj), fv);
} else if (sexp_pairp(obj)) {
if (sexp_symbolp(sexp_car(obj))) {
if ((o1 = env_cell(e, sexp_car(obj)))
&& sexp_corep(o1)
&& (sexp_core_code(sexp_cdr(o1)) == CORE_LAMBDA)) {
return free_vars(e, sexp_cadr(obj), sexp_caddr(obj), fv);
}
}
while (SEXP_PAIRP(obj)) {
fv = free_vars(e, formals, SEXP_CAR(obj), fv);
obj = SEXP_CDR(obj);
while (sexp_pairp(obj)) {
fv = free_vars(e, formals, sexp_car(obj), fv);
obj = sexp_cdr(obj);
}
return fv;
} else {
@ -477,25 +472,25 @@ sexp free_vars (sexp e, sexp formals, sexp obj, sexp fv) {
sexp set_vars (sexp e, sexp formals, sexp obj, sexp sv) {
sexp tmp;
if (SEXP_NULLP(formals))
if (sexp_nullp(formals))
return sv;
if (SEXP_PAIRP(obj)) {
if (SEXP_SYMBOLP(SEXP_CAR(obj))) {
if ((tmp = env_cell(e, SEXP_CAR(obj))) && SEXP_COREP(SEXP_CDR(tmp))) {
if (sexp_core_code(SEXP_CDR(tmp)) == CORE_LAMBDA) {
formals = sexp_lset_diff(formals, SEXP_CADR(obj));
return set_vars(e, formals, SEXP_CADDR(obj), sv);
} else if (sexp_core_code(SEXP_CDR(tmp)) == CORE_SET
&& (sexp_list_index(formals, SEXP_CADR(obj)) >= 0)
&& ! (sexp_list_index(sv, SEXP_CADR(obj)) >= 0)) {
sv = sexp_cons(SEXP_CADR(obj), sv);
return set_vars(e, formals, SEXP_CADDR(obj), sv);
if (sexp_pairp(obj)) {
if (sexp_symbolp(sexp_car(obj))) {
if ((tmp = env_cell(e, sexp_car(obj))) && sexp_corep(sexp_cdr(tmp))) {
if (sexp_core_code(sexp_cdr(tmp)) == CORE_LAMBDA) {
formals = sexp_lset_diff(formals, sexp_cadr(obj));
return set_vars(e, formals, sexp_caddr(obj), sv);
} else if (sexp_core_code(sexp_cdr(tmp)) == CORE_SET
&& (sexp_list_index(formals, sexp_cadr(obj)) >= 0)
&& ! (sexp_list_index(sv, sexp_cadr(obj)) >= 0)) {
sv = sexp_cons(sexp_cadr(obj), sv);
return set_vars(e, formals, sexp_caddr(obj), sv);
}
}
}
while (SEXP_PAIRP(obj)) {
sv = set_vars(e, formals, SEXP_CAR(obj), sv);
obj = SEXP_CDR(obj);
while (sexp_pairp(obj)) {
sv = set_vars(e, formals, sexp_car(obj), sv);
obj = sexp_cdr(obj);
}
}
return sv;
@ -520,8 +515,8 @@ void analyze_lambda (sexp name, sexp formals, sexp body,
emit_push(bc, i, sexp_length(fv2));
emit(bc, i, OP_MAKE_VECTOR);
(*d)++;
for (ls=fv2, k=0; SEXP_PAIRP(ls); ls=SEXP_CDR(ls), k++) {
analyze_var_ref(SEXP_CAR(ls), bc, i, e, params, fv, SEXP_NULL, d);
for (ls=fv2, k=0; sexp_pairp(ls); ls=sexp_cdr(ls), k++) {
analyze_var_ref(sexp_car(ls), bc, i, e, params, fv, SEXP_NULL, d);
emit_push(bc, i, sexp_make_integer(k));
emit(bc, i, OP_STACK_REF);
emit_word(bc, i, 3);
@ -575,8 +570,8 @@ sexp compile(sexp params, sexp obj, sexp e, sexp fv, sexp sv, int done_p) {
sexp_bytecode_length(bc) = INIT_BCODE_SIZE;
sexp_debug("set-vars: ", sv2);
/* box mutable vars */
for (ls=params; SEXP_PAIRP(ls); ls=SEXP_CDR(ls)) {
if ((j = sexp_list_index(sv2, SEXP_CAR(ls)) >= 0)) {
for (ls=params; sexp_pairp(ls); ls=sexp_cdr(ls)) {
if ((j = sexp_list_index(sv2, sexp_car(ls)) >= 0)) {
emit_push(&bc, &i, SEXP_NULL);
emit(&bc, &i, OP_STACK_REF);
emit_word(&bc, &i, j+4);
@ -589,51 +584,51 @@ sexp compile(sexp params, sexp obj, sexp e, sexp fv, sexp sv, int done_p) {
sv = sexp_append(sv2, sv);
/* determine internal defines */
if (sexp_env_parent(e)) {
for (ls=SEXP_NULL; SEXP_PAIRP(obj); obj=SEXP_CDR(obj)) {
core = (SEXP_PAIRP(SEXP_CAR(obj)) && SEXP_SYMBOLP(SEXP_CAAR(obj))
? core_code(e, SEXP_CAAR(obj)) : 0);
for (ls=SEXP_NULL; sexp_pairp(obj); obj=sexp_cdr(obj)) {
core = (sexp_pairp(sexp_car(obj)) && sexp_symbolp(sexp_caar(obj))
? core_code(e, sexp_caar(obj)) : 0);
if (core == CORE_BEGIN) {
obj = sexp_cons(SEXP_CAR(obj),
sexp_append(SEXP_CDAR(obj), SEXP_CDR(obj)));
obj = sexp_cons(sexp_car(obj),
sexp_append(sexp_cdar(obj), sexp_cdr(obj)));
} else {
if (core == CORE_DEFINE) {
if (! define_ok)
errx(1, "definition in non-definition context: %p", obj);
internals = sexp_cons(SEXP_PAIRP(SEXP_CADAR(obj))
? SEXP_CAR(SEXP_CADAR(obj)) : SEXP_CADAR(obj),
internals = sexp_cons(sexp_pairp(sexp_cadar(obj))
? sexp_car(sexp_cadar(obj)) : sexp_cadar(obj),
internals);
} else {
define_ok = 0;
}
ls = sexp_cons(SEXP_CAR(obj), ls);
ls = sexp_cons(sexp_car(obj), ls);
}
}
obj = sexp_reverse(ls);
j = sexp_unbox_integer(sexp_length(internals));
if (SEXP_PAIRP(internals)) {
if (sexp_pairp(internals)) {
/* sexp_write_string("internals: ", cur_error_port); */
/* sexp_write(internals, cur_error_port); */
/* sexp_write_string("\n", cur_error_port); */
e = extend_env_closure(e, internals, 2);
params = sexp_append(internals, params);
for (ls=internals; SEXP_PAIRP(ls); ls=SEXP_CDR(ls))
for (ls=internals; sexp_pairp(ls); ls=sexp_cdr(ls))
emit_push(&bc, &i, (sexp_uint_t) SEXP_UNDEF);
d+=j;
}
}
/* analyze body sequence */
for ( ; SEXP_PAIRP(obj); obj=SEXP_CDR(obj)) {
if (SEXP_PAIRP(SEXP_CDR(obj))) {
analyze(SEXP_CAR(obj), &bc, &i, e, params, fv, sv, &d, 0);
for ( ; sexp_pairp(obj); obj=sexp_cdr(obj)) {
if (sexp_pairp(sexp_cdr(obj))) {
analyze(sexp_car(obj), &bc, &i, e, params, fv, sv, &d, 0);
emit(&bc, &i, OP_DROP);
d--;
} else {
analyze(SEXP_CAR(obj), &bc, &i, e, params, fv, sv, &d,
(! done_p) && (! SEXP_PAIRP(internals))
analyze(sexp_car(obj), &bc, &i, e, params, fv, sv, &d,
(! done_p) && (! sexp_pairp(internals))
);
}
}
if (SEXP_PAIRP(internals)) {
if (sexp_pairp(internals)) {
emit(&bc, &i, OP_STACK_SET);
emit_word(&bc, &i, j+1);
for (j; j>0; j--)
@ -689,7 +684,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
/* fprintf(stderr, " => "); */
/* sexp_write(SEXP_CDR(tmp1), cur_error_port); */
/* fprintf(stderr, "\n"); */
stack[top++]=SEXP_CDR(tmp1);
stack[top++]=sexp_cdr(tmp1);
ip += sizeof(sexp);
break;
case OP_GLOBAL_SET:
@ -767,43 +762,43 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
ip += sizeof(sexp);
break;
case OP_PAIRP:
stack[top-1]=SEXP_PAIRP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_pairp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_NULLP:
stack[top-1]=SEXP_NULLP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_nullp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_CHARP:
stack[top-1]=SEXP_CHARP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_charp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_INTEGERP:
stack[top-1]=SEXP_INTEGERP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_integerp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_SYMBOLP:
stack[top-1]=SEXP_SYMBOLP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_symbolp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_STRINGP:
stack[top-1]=SEXP_STRINGP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_stringp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_VECTORP:
stack[top-1]=SEXP_VECTORP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_vectorp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_PROCEDUREP:
stack[top-1]=SEXP_PROCEDUREP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_procedurep(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_IPORTP:
stack[top-1]=SEXP_IPORTP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_iportp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_OPORTP:
stack[top-1]=SEXP_OPORTP(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
stack[top-1]=sexp_oportp(stack[top-1]) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_EOFP:
stack[top-1]=(stack[top-1] == SEXP_EOF) ? SEXP_TRUE : SEXP_FALSE; break;
case OP_CAR:
/* print_stack(stack, top); */
if (! SEXP_PAIRP(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
stack[top-1]=SEXP_CAR(stack[top-1]); break;
if (! sexp_pairp(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
stack[top-1]=sexp_car(stack[top-1]); break;
case OP_CDR:
if (! SEXP_PAIRP(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
stack[top-1]=SEXP_CDR(stack[top-1]); break;
if (! sexp_pairp(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
stack[top-1]=sexp_cdr(stack[top-1]); break;
case OP_SET_CAR:
if (! SEXP_PAIRP(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
SEXP_CAR(stack[top-1]) = stack[top-2];
if (! sexp_pairp(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
sexp_car(stack[top-1]) = stack[top-2];
stack[top-2]=SEXP_UNDEF;
top--;
break;
case OP_SET_CDR:
if (! SEXP_PAIRP(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
SEXP_CDR(stack[top-1]) = stack[top-2];
if (! sexp_pairp(stack[top-1])) sexp_raise(sexp_intern("not-a-pair"));
sexp_cdr(stack[top-1]) = stack[top-2];
stack[top-2]=SEXP_UNDEF;
top--;
break;
@ -873,11 +868,11 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
i = sexp_unbox_integer(((sexp*)ip)[0]);
tmp1 = stack[top-1];
make_call:
if (SEXP_OPCODEP(tmp1))
if (sexp_opcodep(tmp1))
/* hack, compile an opcode application on the fly */
tmp1 = make_opcode_procedure(tmp1, i, e);
/* print_stack(stack, top); */
if (! SEXP_PROCEDUREP(tmp1)) {
if (! sexp_procedurep(tmp1)) {
fprintf(stderr, "error: non-procedure app: ");
sexp_write(tmp1, cur_error_port);
fprintf(stderr, "\n");
@ -935,14 +930,14 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
tmp2 = stack[top-2];
i = sexp_unbox_integer(sexp_length(tmp2));
top += (i-2);
for ( ; SEXP_PAIRP(tmp2); tmp2=SEXP_CDR(tmp2), top--)
stack[top-1] = SEXP_CAR(tmp2);
for ( ; sexp_pairp(tmp2); tmp2=sexp_cdr(tmp2), top--)
stack[top-1] = sexp_car(tmp2);
top += i+1;
ip -= sizeof(sexp);
goto make_call;
case OP_CALLCC:
tmp1 = stack[top-1];
if (! SEXP_PROCEDUREP(tmp1))
if (! sexp_procedurep(tmp1))
errx(2, "non-procedure application: %p", tmp1);
stack[top] = sexp_make_integer(1);
stack[top+1] = sexp_make_integer(ip);
@ -979,7 +974,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
sexp_write_string("ERROR: ", cur_error_port);
sexp_write(stack[top-1], cur_error_port);
sexp_write_string("\n", cur_error_port);
tmp1 = SEXP_CDR(exception_handler_cell);
tmp1 = sexp_cdr(exception_handler_cell);
stack[top-1] = SEXP_UNDEF;
stack[top] = (sexp) 1;
stack[top+1] = sexp_make_integer(ip+4);
@ -1019,7 +1014,7 @@ sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top) {
ip += ((signed char*)ip)[0];
break;
case OP_DISPLAY:
if (SEXP_STRINGP(stack[top-1])) {
if (sexp_stringp(stack[top-1])) {
sexp_write_string(sexp_string_data(stack[top-1]), stack[top-2]);
break;
}
@ -1098,7 +1093,7 @@ sexp sexp_close_port (sexp port) {
sexp sexp_load (sexp source) {
sexp obj, *stack=SEXP_ALLOC(sizeof(sexp)*INIT_STACK_SIZE);
int closep = 0;
if (SEXP_STRINGP(source)) {
if (sexp_stringp(source)) {
source = sexp_open_input_file(source);
closep = 1;
}

98
sexp.c
View file

@ -53,11 +53,11 @@ static int symbol_table_count = 0;
void sexp_free (sexp obj) {
int len, i;
sexp *elts;
if (SEXP_POINTERP(obj)) {
if (sexp_pointerp(obj)) {
switch (obj->tag) {
case SEXP_PAIR:
sexp_free(SEXP_CAR(obj));
sexp_free(SEXP_CDR(obj));
sexp_free(sexp_car(obj));
sexp_free(sexp_cdr(obj));
break;
case SEXP_VECTOR:
len = sexp_vector_length(obj);
@ -81,60 +81,58 @@ void sexp_free (sexp obj) {
sexp sexp_cons(sexp head, sexp tail) {
sexp pair = SEXP_ALLOC(sexp_sizeof(pair));
pair->tag = SEXP_PAIR;
/* pair->data1 = (void*) head; */
/* pair->data2 = (void*) tail; */
SEXP_CAR(pair) = head;
SEXP_CDR(pair) = tail;
sexp_car(pair) = head;
sexp_cdr(pair) = tail;
return pair;
}
int sexp_listp (sexp obj) {
while (SEXP_PAIRP(obj))
obj = SEXP_CDR(obj);
while (sexp_pairp(obj))
obj = sexp_cdr(obj);
return (obj == SEXP_NULL);
}
int sexp_list_index (sexp ls, sexp elt) {
int i=0;
while (SEXP_PAIRP(ls)) {
if (SEXP_CAR(ls) == elt)
while (sexp_pairp(ls)) {
if (sexp_car(ls) == elt)
return i;
ls = SEXP_CDR(ls);
ls = sexp_cdr(ls);
i++;
}
return -1;
}
sexp sexp_memq (sexp x, sexp ls) {
while (SEXP_PAIRP(ls))
if (x == SEXP_CAR(ls))
while (sexp_pairp(ls))
if (x == sexp_car(ls))
return ls;
else
ls = SEXP_CDR(ls);
ls = sexp_cdr(ls);
return SEXP_FALSE;
}
sexp sexp_assq (sexp x, sexp ls) {
while (SEXP_PAIRP(ls))
if (x == SEXP_CAAR(ls))
while (sexp_pairp(ls))
if (x == sexp_caar(ls))
return ls;
else
ls = SEXP_CDR(ls);
ls = sexp_cdr(ls);
return SEXP_FALSE;
}
sexp sexp_lset_diff(sexp a, sexp b) {
sexp res = SEXP_NULL;
for ( ; SEXP_PAIRP(a); a=SEXP_CDR(a))
if (! sexp_list_index(b, SEXP_CAR(a)) >= 0)
res = sexp_cons(SEXP_CAR(a), res);
for ( ; sexp_pairp(a); a=sexp_cdr(a))
if (! sexp_list_index(b, sexp_car(a)) >= 0)
res = sexp_cons(sexp_car(a), res);
return res;
}
sexp sexp_reverse(sexp ls) {
sexp res = SEXP_NULL;
for ( ; SEXP_PAIRP(ls); ls=SEXP_CDR(ls))
res = sexp_cons(SEXP_CAR(ls), res);
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
res = sexp_cons(sexp_car(ls), res);
return res;
}
@ -142,29 +140,29 @@ sexp sexp_nreverse(sexp ls) {
sexp a, b, tmp;
if (ls == SEXP_NULL) {
return ls;
} else if (! SEXP_PAIRP(ls)) {
} else if (! sexp_pairp(ls)) {
return SEXP_ERROR;
} else {
b=ls;
a=SEXP_CDR(ls);
SEXP_CDR(b) = SEXP_NULL;
for ( ; SEXP_PAIRP(a); b=a, a=tmp) {
tmp=SEXP_CDR(a);
SEXP_CDR(a) = b;
b = ls;
a = sexp_cdr(ls);
sexp_cdr(b) = SEXP_NULL;
for ( ; sexp_pairp(a); b=a, a=tmp) {
tmp = sexp_cdr(a);
sexp_cdr(a) = b;
}
return b;
}
}
sexp sexp_append(sexp a, sexp b) {
for (a=sexp_reverse(a); SEXP_PAIRP(a); a=SEXP_CDR(a))
b = sexp_cons(SEXP_CAR(a), b);
for (a=sexp_reverse(a); sexp_pairp(a); a=sexp_cdr(a))
b = sexp_cons(sexp_car(a), b);
return b;
}
sexp sexp_length(sexp ls) {
sexp_uint_t res=0;
for ( ; SEXP_PAIRP(ls); res++, ls=SEXP_CDR(ls))
for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls))
;
return sexp_make_integer(res);
}
@ -184,8 +182,6 @@ sexp sexp_make_string(char *str) {
char *mystr = SEXP_ALLOC(len+1);
memcpy(mystr, str, len+1);
s->tag = SEXP_STRING;
/* s->data1 = (void*) len; */
/* s->data2 = (void*) mystr; */
sexp_string_length(s) = len;
sexp_string_data(s) = mystr;
return s;
@ -250,8 +246,6 @@ sexp sexp_intern(char *str) {
memcpy(mystr, str, len+1);
mystr[len]=0;
sym->tag = SEXP_SYMBOL;
/* sym->data1 = (void*) len; */
/* sym->data2 = (void*) mystr; */
sexp_symbol_length(sym) = len;
sexp_symbol_data(sym) = mystr;
symbol_table[cell] = sym;
@ -268,8 +262,6 @@ sexp sexp_make_vector(sexp len, sexp dflt) {
x[i] = dflt;
}
v->tag = SEXP_VECTOR;
/* v->data1 = (void*) clen; */
/* v->data2 = (void*) x; */
sexp_vector_length(v) = clen;
sexp_vector_data(v) = x;
return v;
@ -279,8 +271,8 @@ sexp sexp_list_to_vector(sexp ls) {
sexp x, vec = sexp_make_vector(sexp_length(ls), SEXP_UNDEF);
sexp *elts = sexp_vector_data(vec);
int i;
for (i=0, x=ls; SEXP_PAIRP(x); i++, x=SEXP_CDR(x))
elts[i] = SEXP_CAR(x);
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
elts[i] = sexp_car(x);
return vec;
}
@ -335,7 +327,6 @@ int sstream_close(void *vec) {
sexp sexp_make_input_port(FILE* in) {
sexp p = SEXP_ALLOC(sexp_sizeof(port));
p->tag = SEXP_IPORT;
/* p->data1 = in; */
sexp_port_stream(p) = in;
return p;
}
@ -343,7 +334,6 @@ sexp sexp_make_input_port(FILE* in) {
sexp sexp_make_output_port(FILE* out) {
sexp p = SEXP_ALLOC(sexp_sizeof(port));
p->tag = SEXP_OPORT;
/* p->data1 = out; */
sexp_port_stream(p) = out;
return p;
}
@ -371,16 +361,16 @@ void sexp_write (sexp obj, sexp out) {
if (! obj) {
sexp_write_string("#<null>", out);
} else if (SEXP_POINTERP(obj)) {
} else if (sexp_pointerp(obj)) {
switch (obj->tag) {
case SEXP_PAIR:
sexp_write_char('(', out);
sexp_write(SEXP_CAR(obj), out);
for (x=SEXP_CDR(obj); SEXP_PAIRP(x); x=SEXP_CDR(x)) {
sexp_write(sexp_car(obj), out);
for (x=sexp_cdr(obj); sexp_pairp(x); x=sexp_cdr(x)) {
sexp_write_char(' ', out);
sexp_write(SEXP_CAR(x), out);
sexp_write(sexp_car(x), out);
}
if (! SEXP_NULLP(x)) {
if (! sexp_nullp(x)) {
sexp_write_string(" . ", out);
sexp_write(x, out);
}
@ -438,15 +428,15 @@ void sexp_write (sexp obj, sexp out) {
sexp_write_char('"', out);
break;
}
} else if (SEXP_INTEGERP(obj)) {
} else if (sexp_integerp(obj)) {
sexp_printf(out, "%d", sexp_unbox_integer(obj));
} else if (SEXP_CHARP(obj)) {
} else if (sexp_charp(obj)) {
if (33 <= sexp_unbox_character(obj) < 127) {
sexp_printf(out, "#\\%c", sexp_unbox_character(obj));
} else {
sexp_printf(out, "#\\x%02d", sexp_unbox_character(obj));
}
} else if (SEXP_SYMBOLP(obj)) {
} else if (sexp_symbolp(obj)) {
#if USE_HUFF_SYMS
if (((sexp_uint_t)obj&7)==7) {
@ -564,7 +554,7 @@ sexp sexp_read_number(sexp in, int base) {
return SEXP_ERROR;
}
tmp = sexp_read_float_tail(in, res);
if (negativep && SEXP_FLONUMP(tmp))
if (negativep && sexp_flonump(tmp))
sexp_flonum_value(tmp) = -1 * sexp_flonum_value(tmp);
return tmp;
} else {
@ -634,7 +624,7 @@ sexp sexp_read_raw (sexp in) {
} else {
tmp2 = res;
res = sexp_nreverse(res);
SEXP_CDR(tmp2) = tmp;
sexp_cdr(tmp2) = tmp;
return res;
}
}
@ -794,8 +784,6 @@ void sexp_init() {
the_unquote_splicing_symbol = sexp_intern("unquote-splicing");
the_empty_vector = SEXP_ALLOC(sexp_sizeof(vector));
the_empty_vector->tag = SEXP_VECTOR;
/* the_empty_vector->data1 = 0; */
/* the_empty_vector->data2 = 0; */
sexp_vector_length(the_empty_vector) = 0;
sexp_vector_data(the_empty_vector) = NULL;
}

76
sexp.h
View file

@ -162,31 +162,31 @@ struct sexp_struct {
#define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */
#define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */
#define SEXP_NULLP(x) ((x) == SEXP_NULL)
#define SEXP_POINTERP(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_POINTER_TAG)
#define SEXP_INTEGERP(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_FIXNUM_TAG)
#define SEXP_ISYMBOLP(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_ISYMBOL_TAG)
#define SEXP_CHARP(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG)
#define SEXP_BOOLEANP(x) (((x) == SEXP_TRUE) || ((x) == SEXP_FALSE))
#define sexp_nullp(x) ((x) == SEXP_NULL)
#define sexp_pointerp(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_POINTER_TAG)
#define sexp_integerp(x) (((sexp_uint_t)(x) & SEXP_FIXNUM_MASK) == SEXP_FIXNUM_TAG)
#define sexp_isymbolp(x) (((sexp_uint_t)(x) & SEXP_IMMEDIATE_MASK) == SEXP_ISYMBOL_TAG)
#define sexp_charp(x) (((sexp_uint_t)(x) & SEXP_EXTENDED_MASK) == SEXP_CHAR_TAG)
#define sexp_booleanp(x) (((x) == SEXP_TRUE) || ((x) == SEXP_FALSE))
#define SEXP_CHECK_TAG(x,t) (SEXP_POINTERP(x) && (x)->tag == (t))
#define SEXP_CHECK_TAG(x,t) (sexp_pointerp(x) && (x)->tag == (t))
#define SEXP_PAIRP(x) (SEXP_CHECK_TAG(x, SEXP_PAIR))
#define SEXP_STRINGP(x) (SEXP_CHECK_TAG(x, SEXP_STRING))
#define SEXP_LSYMBOLP(x) (SEXP_CHECK_TAG(x, SEXP_SYMBOL))
#define SEXP_VECTORP(x) (SEXP_CHECK_TAG(x, SEXP_VECTOR))
#define SEXP_FLONUMP(x) (SEXP_CHECK_TAG(x, SEXP_FLONUM))
#define SEXP_IPORTP(x) (SEXP_CHECK_TAG(x, SEXP_IPORT))
#define SEXP_OPORTP(x) (SEXP_CHECK_TAG(x, SEXP_OPORT))
#define SEXP_EXCEPTIONP(x) (SEXP_CHECK_TAG(x, SEXP_EXCEPTION))
#define SEXP_PROCEDUREP(x) (SEXP_CHECK_TAG(x, SEXP_PROCEDURE))
#define SEXP_ENVP(x) (SEXP_CHECK_TAG(x, SEXP_ENV))
#define SEXP_BYTECODEP(x) (SEXP_CHECK_TAG(x, SEXP_BYTECODE))
#define SEXP_COREP(x) (SEXP_CHECK_TAG(x, SEXP_CORE))
#define SEXP_OPCODEP(x) (SEXP_CHECK_TAG(x, SEXP_OPCODE))
#define SEXP_MACROP(x) (SEXP_CHECK_TAG(x, SEXP_MACRO))
#define sexp_pairp(x) (SEXP_CHECK_TAG(x, SEXP_PAIR))
#define sexp_stringp(x) (SEXP_CHECK_TAG(x, SEXP_STRING))
#define sexp_lsymbolp(x) (SEXP_CHECK_TAG(x, SEXP_SYMBOL))
#define sexp_vectorp(x) (SEXP_CHECK_TAG(x, SEXP_VECTOR))
#define sexp_flonump(x) (SEXP_CHECK_TAG(x, SEXP_FLONUM))
#define sexp_iportp(x) (SEXP_CHECK_TAG(x, SEXP_IPORT))
#define sexp_oportp(x) (SEXP_CHECK_TAG(x, SEXP_OPORT))
#define sexp_exceptionp(x) (SEXP_CHECK_TAG(x, SEXP_EXCEPTION))
#define sexp_procedurep(x) (SEXP_CHECK_TAG(x, SEXP_PROCEDURE))
#define sexp_envp(x) (SEXP_CHECK_TAG(x, SEXP_ENV))
#define sexp_bytecodep(x) (SEXP_CHECK_TAG(x, SEXP_BYTECODE))
#define sexp_corep(x) (SEXP_CHECK_TAG(x, SEXP_CORE))
#define sexp_opcodep(x) (SEXP_CHECK_TAG(x, SEXP_OPCODE))
#define sexp_macrop(x) (SEXP_CHECK_TAG(x, SEXP_MACRO))
#define SEXP_SYMBOLP(x) (SEXP_ISYMBOLP(x) || SEXP_LSYMBOLP(x))
#define sexp_symbolp(x) (sexp_isymbolp(x) || sexp_lsymbolp(x))
#if USE_HUFF_SYMS
#define SEXP_DOTP(x) (((sexp_uint_t)(x))==((0x5D00<<SEXP_IMMEDIATE_BITS)+SEXP_ISYMBOL_TAG))
@ -292,25 +292,25 @@ void sexp_printf(sexp port, sexp fmt, ...);
#define sexp_list3(a, b, c) sexp_cons(a, sexp_cons(b, sexp_cons(c, SEXP_NULL)))
#define sexp_list4(a, b, c, d) sexp_cons(a, sexp_cons(b, sexp_cons(c, sexp_cons(d, SEXP_NULL))))
#define SEXP_CAR(x) ((x)->value.pair.car)
#define SEXP_CDR(x) ((x)->value.pair.cdr)
#define sexp_car(x) ((x)->value.pair.car)
#define sexp_cdr(x) ((x)->value.pair.cdr)
#define SEXP_CAAR(x) (SEXP_CAR(SEXP_CAR(x)))
#define SEXP_CADR(x) (SEXP_CAR(SEXP_CDR(x)))
#define SEXP_CDAR(x) (SEXP_CDR(SEXP_CAR(x)))
#define SEXP_CDDR(x) (SEXP_CDR(SEXP_CDR(x)))
#define sexp_caar(x) (sexp_car(sexp_car(x)))
#define sexp_cadr(x) (sexp_car(sexp_cdr(x)))
#define sexp_cdar(x) (sexp_cdr(sexp_car(x)))
#define sexp_cddr(x) (sexp_cdr(sexp_cdr(x)))
#define SEXP_CAAAR(x) (SEXP_CAR(SEXP_CAAR(x)))
#define SEXP_CAADR(x) (SEXP_CAR(SEXP_CADR(x)))
#define SEXP_CADAR(x) (SEXP_CAR(SEXP_CDAR(x)))
#define SEXP_CADDR(x) (SEXP_CAR(SEXP_CDDR(x)))
#define SEXP_CDAAR(x) (SEXP_CDR(SEXP_CAAR(x)))
#define SEXP_CDADR(x) (SEXP_CDR(SEXP_CADR(x)))
#define SEXP_CDDAR(x) (SEXP_CDR(SEXP_CDAR(x)))
#define SEXP_CDDDR(x) (SEXP_CDR(SEXP_CDDR(x)))
#define sexp_caaar(x) (sexp_car(sexp_caar(x)))
#define sexp_caadr(x) (sexp_car(sexp_cadr(x)))
#define sexp_cadar(x) (sexp_car(sexp_cdar(x)))
#define sexp_caddr(x) (sexp_car(sexp_cddr(x)))
#define sexp_cdaar(x) (sexp_cdr(sexp_caar(x)))
#define sexp_cdadr(x) (sexp_cdr(sexp_cadr(x)))
#define sexp_cddar(x) (sexp_cdr(sexp_cdar(x)))
#define sexp_cdddr(x) (sexp_cdr(sexp_cddr(x)))
#define SEXP_CADDDR(x) (SEXP_CADR(SEXP_CDDR(x)))
#define SEXP_CDDDDR(x) (SEXP_CDDR(SEXP_CDDR(x)))
#define sexp_cadddr(x) (sexp_cadr(sexp_cddr(x)))
#define sexp_cddddr(x) (sexp_cddr(sexp_cddr(x)))
sexp sexp_cons(sexp head, sexp tail);
int sexp_listp(sexp obj);