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

detecting undefined variables

Browse source
This commit is contained in:
Alex Shinn 2009-04-03 17:58:03 +09:00
parent 636502de73
commit 55841679e8
7 changed files with 69 additions and 52 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
debug.c
View file

@ -5,7 +5,8 @@
static const char* reverse_opcode_names[] = static const char* reverse_opcode_names[] =
{"NOOP", "ERROR", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL", {"NOOP", "ERROR", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL",
"FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "EVAL", "JUMP-UNLESS", "FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "EVAL", "JUMP-UNLESS",
"JUMP", "PUSH", "DROP", "STACK-REF", "LOCAL-REF", "LOCAL-SET", "JUMP", "PUSH", "DROP", "GLOBAL-REF", "GLOBAL-KNOWN-REF", "STACK-REF",
"LOCAL-REF", "LOCAL-SET",
"CLOSURE-REF", "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", "STRING-REF", "CLOSURE-REF", "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", "STRING-REF",
"STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR", "AND", "STRING-SET", "STRING-LENGTH", "MAKE-PROCEDURE", "MAKE-VECTOR", "AND",
"NULL?", "FIXNUM?", "SYMBOL?", "CHAR?", "NULL?", "FIXNUM?", "SYMBOL?", "CHAR?",
@ -45,6 +46,8 @@ static sexp sexp_disasm (sexp bc, sexp out) {
sexp_printf(out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]); sexp_printf(out, "%ld", (sexp_sint_t) ((sexp*)ip)[0]);
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_GLOBAL_REF:
case OP_GLOBAL_KNOWN_REF:
case OP_TAIL_CALL: case OP_TAIL_CALL:
case OP_CALL: case OP_CALL:
case OP_PUSH: case OP_PUSH:
@ -55,7 +58,7 @@ static sexp sexp_disasm (sexp bc, sexp out) {
sexp_write_char('\n', out); sexp_write_char('\n', out);
if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc)) if (ip - sexp_bytecode_data(bc) < sexp_bytecode_length(bc))
goto loop; goto loop;
return SEXP_UNDEF; return SEXP_VOID;
} }
static void print_bytecode (sexp bc) { static void print_bytecode (sexp bc) {

82
eval.c
View file

@ -307,7 +307,7 @@ static sexp analyze_app (sexp x, sexp context) {
static sexp analyze_seq (sexp ls, sexp context) { static sexp analyze_seq (sexp ls, sexp context) {
sexp res, tmp; sexp res, tmp;
if (sexp_nullp(ls)) if (sexp_nullp(ls))
res = SEXP_UNDEF; res = SEXP_VOID;
else if (sexp_nullp(sexp_cdr(ls))) else if (sexp_nullp(sexp_cdr(ls)))
res = analyze(sexp_car(ls), context); res = analyze(sexp_car(ls), context);
else { else {
@ -369,7 +369,7 @@ static sexp analyze_lambda (sexp x, sexp context) {
tmp = sexp_car(ls); tmp = sexp_car(ls);
if (sexp_pairp(sexp_cadr(tmp))) { if (sexp_pairp(sexp_cadr(tmp))) {
name = sexp_caadr(tmp); name = sexp_caadr(tmp);
value = analyze_lambda(sexp_cons(SEXP_UNDEF, sexp_cons(sexp_cdadr(tmp), value = analyze_lambda(sexp_cons(SEXP_VOID, sexp_cons(sexp_cdadr(tmp),
sexp_cddr(tmp))), sexp_cddr(tmp))),
context); context);
} else { } else {
@ -395,7 +395,7 @@ static sexp analyze_if (sexp x, sexp context) {
sexp test, pass, fail, fail_expr; sexp test, pass, fail, fail_expr;
analyze_bind(test, sexp_cadr(x), context); analyze_bind(test, sexp_cadr(x), context);
analyze_bind(pass, sexp_caddr(x), context); analyze_bind(pass, sexp_caddr(x), context);
fail_expr = sexp_pairp(sexp_cdddr(x)) ? sexp_cadddr(x) : SEXP_UNDEF; fail_expr = sexp_pairp(sexp_cdddr(x)) ? sexp_cadddr(x) : SEXP_VOID;
analyze_bind(fail, fail_expr, context); analyze_bind(fail, fail_expr, context);
return sexp_make_cnd(test, pass, fail); return sexp_make_cnd(test, pass, fail);
} }
@ -409,12 +409,12 @@ static sexp analyze_define (sexp x, sexp context) {
sexp_push(sexp_lambda_sv(sexp_env_lambda(env)), name); sexp_push(sexp_lambda_sv(sexp_env_lambda(env)), name);
sexp_push(sexp_lambda_locals(sexp_env_lambda(env)), name); sexp_push(sexp_lambda_locals(sexp_env_lambda(env)), name);
sexp_push(sexp_lambda_defs(sexp_env_lambda(env)), x); sexp_push(sexp_lambda_defs(sexp_env_lambda(env)), x);
return SEXP_UNDEF; return SEXP_VOID;
} else { } else {
env_cell_create(env, name, SEXP_DEF); env_cell_create(env, name, SEXP_VOID);
} }
if (sexp_pairp(sexp_cadr(x))) if (sexp_pairp(sexp_cadr(x)))
value = analyze_lambda(sexp_cons(SEXP_UNDEF, value = analyze_lambda(sexp_cons(SEXP_VOID,
sexp_cons(sexp_cdadr(x), sexp_cddr(x))), sexp_cons(sexp_cdadr(x), sexp_cddr(x))),
context); context);
else else
@ -431,9 +431,9 @@ static sexp analyze_define_syntax (sexp x, sexp context) {
return sexp_compile_error("non-top-level define-syntax", sexp_list1(x)); return sexp_compile_error("non-top-level define-syntax", sexp_list1(x));
proc = eval_in_context(sexp_caddr(x), context); proc = eval_in_context(sexp_caddr(x), context);
analyze_check_exception(proc); analyze_check_exception(proc);
cell = env_cell_create(sexp_context_env(context), name, SEXP_UNDEF); cell = env_cell_create(sexp_context_env(context), name, SEXP_VOID);
sexp_cdr(cell) = sexp_make_macro(proc, sexp_context_env(context)); sexp_cdr(cell) = sexp_make_macro(proc, sexp_context_env(context));
return SEXP_UNDEF; return SEXP_VOID;
} }
static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) { static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
@ -445,7 +445,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
sexp_cons(sexp_caar(ls), sexp_cons(sexp_caar(ls),
sexp_make_macro(proc, sexp_context_env(eval_ctx)))); sexp_make_macro(proc, sexp_context_env(eval_ctx))));
} }
return SEXP_UNDEF; return SEXP_VOID;
} }
static sexp analyze_let_syntax (sexp x, sexp context) { static sexp analyze_let_syntax (sexp x, sexp context) {
@ -623,9 +623,13 @@ static void generate_ref (sexp ref, sexp context, int unboxp) {
sexp lam; sexp lam;
if (! sexp_lambdap(sexp_ref_loc(ref))) { if (! sexp_lambdap(sexp_ref_loc(ref))) {
/* global ref */ /* global ref */
emit_push(sexp_ref_cell(ref), context); if (unboxp) {
if (unboxp) emit((sexp_cdr(sexp_ref_cell(ref)) == SEXP_UNDEF)
emit(OP_CDR, context); ? OP_GLOBAL_REF : OP_GLOBAL_KNOWN_REF,
context);
emit_word((sexp_uint_t)sexp_ref_cell(ref), context);
} else
emit_push(sexp_ref_cell(ref), context);
} else { } else {
lam = sexp_context_lambda(context); lam = sexp_context_lambda(context);
generate_non_global_ref(sexp_ref_name(ref), sexp_ref_cell(ref), lam, generate_non_global_ref(sexp_ref_name(ref), sexp_ref_cell(ref), lam,
@ -769,7 +773,7 @@ static void generate_lambda (sexp lambda, sexp context) {
sexp_context_lambda(ctx) = lambda; sexp_context_lambda(ctx) = lambda;
/* allocate space for local vars */ /* allocate space for local vars */
for (ls=sexp_lambda_locals(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) for (ls=sexp_lambda_locals(lambda); sexp_pairp(ls); ls=sexp_cdr(ls))
emit_push(SEXP_UNDEF, ctx); emit_push(SEXP_VOID, ctx);
/* box mutable vars */ /* box mutable vars */
for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) { for (ls=sexp_lambda_sv(lambda); sexp_pairp(ls); ls=sexp_cdr(ls)) {
k = sexp_param_index(lambda, sexp_car(ls)); k = sexp_param_index(lambda, sexp_car(ls));
@ -790,11 +794,11 @@ static void generate_lambda (sexp lambda, sexp context) {
bc = finalize_bytecode(ctx); bc = finalize_bytecode(ctx);
if (sexp_nullp(fv)) { if (sexp_nullp(fv)) {
/* shortcut, no free vars */ /* shortcut, no free vars */
vec = sexp_make_vector(sexp_make_integer(0), SEXP_UNDEF); vec = sexp_make_vector(sexp_make_integer(0), SEXP_VOID);
generate_lit(sexp_make_procedure(flags, len, bc, vec), context); generate_lit(sexp_make_procedure(flags, len, bc, vec), context);
} else { } else {
/* push the closed vars */ /* push the closed vars */
emit_push(SEXP_UNDEF, context); emit_push(SEXP_VOID, context);
emit_push(sexp_length(fv), context); emit_push(sexp_length(fv), context);
emit(OP_MAKE_VECTOR, context); emit(OP_MAKE_VECTOR, context);
sexp_context_depth(context)--; sexp_context_depth(context)--;
@ -934,7 +938,7 @@ static sexp make_opcode_procedure (sexp op, sexp_uint_t i, sexp env,
res = sexp_make_procedure(sexp_make_integer(0), res = sexp_make_procedure(sexp_make_integer(0),
sexp_make_integer(i), sexp_make_integer(i),
bc, bc,
SEXP_UNDEF); SEXP_VOID);
if (i == sexp_opcode_num_args(op)) if (i == sexp_opcode_num_args(op))
sexp_opcode_proc(op) = res; sexp_opcode_proc(op) = res;
return res; return res;
@ -945,7 +949,7 @@ static sexp make_opcode_procedure (sexp op, sexp_uint_t i, sexp env,
static sexp sexp_save_stack(sexp *stack, sexp_uint_t to) { static sexp sexp_save_stack(sexp *stack, sexp_uint_t to) {
sexp res, *data; sexp res, *data;
sexp_uint_t i; sexp_uint_t i;
res = sexp_make_vector(sexp_make_integer(to), SEXP_UNDEF); res = sexp_make_vector(sexp_make_integer(to), SEXP_VOID);
data = sexp_vector_data(res); data = sexp_vector_data(res);
for (i=0; i<to; i++) for (i=0; i<to; i++)
data[i] = stack[i]; data[i] = stack[i];
@ -1151,6 +1155,14 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
case OP_DROP: case OP_DROP:
top--; top--;
break; break;
case OP_GLOBAL_REF:
if (sexp_cdr(_WORD0) == SEXP_UNDEF)
sexp_raise("undefined variable", sexp_list1(sexp_car(_WORD0)));
/* ... FALLTHROUGH ... */
case OP_GLOBAL_KNOWN_REF:
_PUSH(sexp_cdr(_WORD0));
ip += sizeof(sexp);
break;
case OP_STACK_REF: /* `pick' in forth */ case OP_STACK_REF: /* `pick' in forth */
stack[top] = stack[top - _SWORD0]; stack[top] = stack[top - _SWORD0];
ip += sizeof(sexp); ip += sizeof(sexp);
@ -1163,7 +1175,7 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
break; break;
case OP_LOCAL_SET: case OP_LOCAL_SET:
stack[fp - 1 - _SWORD0] = _ARG1; stack[fp - 1 - _SWORD0] = _ARG1;
_ARG1 = SEXP_UNDEF; _ARG1 = SEXP_VOID;
ip += sizeof(sexp); ip += sizeof(sexp);
break; break;
case OP_CLOSURE_REF: case OP_CLOSURE_REF:
@ -1180,7 +1192,7 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
if (! sexp_vectorp(_ARG1)) if (! sexp_vectorp(_ARG1))
sexp_raise("vector-set!: not a vector", sexp_list1(_ARG1)); sexp_raise("vector-set!: not a vector", sexp_list1(_ARG1));
sexp_vector_set(_ARG1, _ARG2, _ARG3); sexp_vector_set(_ARG1, _ARG2, _ARG3);
_ARG3 = SEXP_UNDEF; _ARG3 = SEXP_VOID;
top-=2; top-=2;
break; break;
case OP_VECTOR_LENGTH: case OP_VECTOR_LENGTH:
@ -1192,7 +1204,7 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
break; break;
case OP_STRING_SET: case OP_STRING_SET:
sexp_string_set(_ARG1, _ARG2, _ARG3); sexp_string_set(_ARG1, _ARG2, _ARG3);
_ARG3 = SEXP_UNDEF; _ARG3 = SEXP_VOID;
top-=2; top-=2;
break; break;
case OP_STRING_LENGTH: case OP_STRING_LENGTH:
@ -1236,14 +1248,14 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
if (! sexp_pairp(_ARG1)) if (! sexp_pairp(_ARG1))
sexp_raise("set-car!: not a pair", sexp_list1(_ARG1)); sexp_raise("set-car!: not a pair", sexp_list1(_ARG1));
sexp_car(_ARG1) = _ARG2; sexp_car(_ARG1) = _ARG2;
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
case OP_SET_CDR: case OP_SET_CDR:
if (! sexp_pairp(_ARG1)) if (! sexp_pairp(_ARG1))
sexp_raise("set-cdr!: not a pair", sexp_list1(_ARG1)); sexp_raise("set-cdr!: not a pair", sexp_list1(_ARG1));
sexp_cdr(_ARG1) = _ARG2; sexp_cdr(_ARG1) = _ARG2;
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
case OP_CONS: case OP_CONS:
@ -1426,33 +1438,33 @@ sexp vm(sexp bc, sexp cp, sexp context, sexp* stack, sexp_sint_t top) {
case OP_DISPLAY: case OP_DISPLAY:
if (sexp_stringp(_ARG1)) { if (sexp_stringp(_ARG1)) {
sexp_write_string(sexp_string_data(_ARG1), _ARG2); sexp_write_string(sexp_string_data(_ARG1), _ARG2);
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
} else if (sexp_charp(_ARG1)) { } else if (sexp_charp(_ARG1)) {
sexp_write_char(sexp_unbox_character(_ARG1), _ARG2); sexp_write_char(sexp_unbox_character(_ARG1), _ARG2);
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
} }
/* ... FALLTHROUGH ... */ /* ... FALLTHROUGH ... */
case OP_WRITE: case OP_WRITE:
sexp_write(_ARG1, _ARG2); sexp_write(_ARG1, _ARG2);
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
case OP_WRITE_CHAR: case OP_WRITE_CHAR:
sexp_write_char(sexp_unbox_character(_ARG1), _ARG2); sexp_write_char(sexp_unbox_character(_ARG1), _ARG2);
_ARG2 = SEXP_UNDEF; _ARG2 = SEXP_VOID;
top--; top--;
break; break;
case OP_NEWLINE: case OP_NEWLINE:
sexp_write_char('\n', _ARG1); sexp_write_char('\n', _ARG1);
_ARG1 = SEXP_UNDEF; _ARG1 = SEXP_VOID;
break; break;
case OP_FLUSH_OUTPUT: case OP_FLUSH_OUTPUT:
sexp_flush(_ARG1); sexp_flush(_ARG1);
_ARG1 = SEXP_UNDEF; _ARG1 = SEXP_VOID;
break; break;
case OP_READ: case OP_READ:
_ARG1 = sexp_read(_ARG1); _ARG1 = sexp_read(_ARG1);
@ -1498,7 +1510,7 @@ sexp sexp_open_output_file (sexp path) {
sexp sexp_close_port (sexp port) { sexp sexp_close_port (sexp port) {
fclose(sexp_port_stream(port)); fclose(sexp_port_stream(port));
return SEXP_UNDEF; return SEXP_VOID;
} }
sexp sexp_load (sexp source, sexp env) { sexp sexp_load (sexp source, sexp env) {
@ -1510,7 +1522,7 @@ sexp sexp_load (sexp source, sexp env) {
break; break;
} }
if (obj == SEXP_EOF) if (obj == SEXP_EOF)
res = SEXP_UNDEF; res = SEXP_VOID;
sexp_close_port(in); sexp_close_port(in);
return res; return res;
} }
@ -1580,7 +1592,7 @@ static sexp sexp_string_concatenate (sexp str_ls) {
return sexp_type_exception("not a string", sexp_car(ls)); return sexp_type_exception("not a string", sexp_car(ls));
else else
len += sexp_string_length(sexp_car(ls)); len += sexp_string_length(sexp_car(ls));
res = sexp_make_string(sexp_make_integer(len), SEXP_UNDEF); res = sexp_make_string(sexp_make_integer(len), SEXP_VOID);
p = sexp_string_data(res); p = sexp_string_data(res);
for (ls=str_ls; sexp_pairp(ls); ls=sexp_cdr(ls)) { for (ls=str_ls; sexp_pairp(ls); ls=sexp_cdr(ls)) {
len = sexp_string_length(sexp_car(ls)); len = sexp_string_length(sexp_car(ls));
@ -1657,7 +1669,7 @@ static sexp sexp_make_standard_env (sexp version) {
&& sexp_opcode_opt_param_p(op) && sexp_opcode_opt_param_p(op)
&& sexp_opcode_default(op)) { && sexp_opcode_default(op)) {
sym = sexp_intern((char*)sexp_opcode_default(op)); sym = sexp_intern((char*)sexp_opcode_default(op));
cell = env_cell_create(e, sym, SEXP_UNDEF); cell = env_cell_create(e, sym, SEXP_VOID);
sexp_opcode_default(op) = cell; sexp_opcode_default(op) = cell;
} }
env_define(e, sexp_intern(sexp_opcode_name(op)), op); env_define(e, sexp_intern(sexp_opcode_name(op)), op);
@ -1681,7 +1693,7 @@ sexp apply(sexp proc, sexp args, sexp context) {
stack[top] = sexp_make_integer(top); stack[top] = sexp_make_integer(top);
top++; top++;
stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer)); stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer));
stack[top++] = sexp_make_vector(0, SEXP_UNDEF); stack[top++] = sexp_make_vector(0, SEXP_VOID);
stack[top++] = sexp_make_integer(0); stack[top++] = sexp_make_integer(0);
return vm(sexp_procedure_code(proc), return vm(sexp_procedure_code(proc),
sexp_procedure_vars(proc), sexp_procedure_vars(proc),
@ -1700,7 +1712,7 @@ sexp compile (sexp x, sexp context) {
return sexp_make_procedure(sexp_make_integer(0), return sexp_make_procedure(sexp_make_integer(0),
sexp_make_integer(0), sexp_make_integer(0),
finalize_bytecode(ctx), finalize_bytecode(ctx),
sexp_make_vector(0, SEXP_UNDEF)); sexp_make_vector(0, SEXP_VOID));
} }
sexp eval_in_context (sexp obj, sexp context) { sexp eval_in_context (sexp obj, sexp context) {
@ -1709,7 +1721,7 @@ sexp eval_in_context (sexp obj, sexp context) {
sexp_print_exception(thunk, env_global_ref(sexp_context_env(context), sexp_print_exception(thunk, env_global_ref(sexp_context_env(context),
the_cur_err_symbol, the_cur_err_symbol,
SEXP_FALSE)); SEXP_FALSE));
return SEXP_UNDEF; return SEXP_VOID;
} }
return apply(thunk, SEXP_NULL, context); return apply(thunk, SEXP_NULL, context);
} }

2
eval.h
View file

@ -70,6 +70,8 @@ enum opcode_names {
OP_JUMP, OP_JUMP,
OP_PUSH, OP_PUSH,
OP_DROP, OP_DROP,
OP_GLOBAL_REF,
OP_GLOBAL_KNOWN_REF,
OP_STACK_REF, OP_STACK_REF,
OP_LOCAL_REF, OP_LOCAL_REF,
OP_LOCAL_SET, OP_LOCAL_SET,

6
main.c
View file

@ -17,7 +17,7 @@ void repl (sexp context) {
sexp_print_exception(obj, err); sexp_print_exception(obj, err);
} else { } else {
res = eval_in_context(obj, context); res = eval_in_context(obj, context);
if (res != SEXP_UNDEF) { if (res != SEXP_VOID) {
sexp_write(res, out); sexp_write(res, out);
sexp_write_char('\n', out); sexp_write_char('\n', out);
} }
@ -32,12 +32,12 @@ void run_main (int argc, char **argv) {
env = sexp_make_standard_env(sexp_make_integer(5)); env = sexp_make_standard_env(sexp_make_integer(5));
context = sexp_make_context(NULL, env); context = sexp_make_context(NULL, env);
sexp_context_tailp(context) = 0; sexp_context_tailp(context) = 0;
emit_push(SEXP_UNDEF, context); emit_push(SEXP_VOID, context);
emit(OP_DONE, context); emit(OP_DONE, context);
err_handler = sexp_make_procedure(sexp_make_integer(0), err_handler = sexp_make_procedure(sexp_make_integer(0),
sexp_make_integer(0), sexp_make_integer(0),
finalize_bytecode(context), finalize_bytecode(context),
sexp_make_vector(0, SEXP_UNDEF)); sexp_make_vector(0, SEXP_VOID));
env_define(env, the_err_handler_symbol, err_handler); env_define(env, the_err_handler_symbol, err_handler);
/* parse options */ /* parse options */

2
opcodes.c
View file

@ -41,7 +41,7 @@ _OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 1, ">=", 0, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_EQN, 0, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL), _OP(OPC_ARITHMETIC_CMP, OP_EQN, 0, 1, SEXP_FIXNUM, 0, 0, "=", 0, NULL),
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL), _OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", 0, NULL),
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL), _OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", 0, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_UNDEF, NULL), _OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 1, 1, SEXP_FIXNUM, 0, 0, "make-vector", SEXP_VOID, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL), _OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", 0, NULL),
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", 0, NULL), _OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", 0, NULL),
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", 0, NULL), _OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", 0, NULL),

16
sexp.c
View file

@ -147,7 +147,7 @@ sexp sexp_print_exception (sexp exn, sexp out) {
} else { } else {
sexp_write_string("\n", out); sexp_write_string("\n", out);
} }
return SEXP_UNDEF; return SEXP_VOID;
} }
static sexp sexp_read_error (char *message, sexp irritants, sexp port) { static sexp sexp_read_error (char *message, sexp irritants, sexp port) {
@ -296,7 +296,7 @@ sexp sexp_make_string(sexp len, sexp ch) {
sexp sexp_c_string(char *str) { sexp sexp_c_string(char *str) {
sexp_uint_t len = strlen(str); sexp_uint_t len = strlen(str);
sexp s = sexp_make_string(sexp_make_integer(len), SEXP_UNDEF); sexp s = sexp_make_string(sexp_make_integer(len), SEXP_VOID);
memcpy(sexp_string_data(s), str, len); memcpy(sexp_string_data(s), str, len);
return s; return s;
} }
@ -318,7 +318,7 @@ sexp sexp_substring (sexp str, sexp start, sexp end) {
|| (end < start)) || (end < start))
return sexp_range_exception(str, start, end); return sexp_range_exception(str, start, end);
res = sexp_make_string(sexp_fx_sub(end, start), res = sexp_make_string(sexp_fx_sub(end, start),
SEXP_UNDEF); SEXP_VOID);
memcpy(sexp_string_data(res), memcpy(sexp_string_data(res),
sexp_string_data(str)+sexp_unbox_integer(start), sexp_string_data(str)+sexp_unbox_integer(start),
sexp_string_length(res)); sexp_string_length(res));
@ -393,7 +393,7 @@ sexp sexp_make_vector(sexp len, sexp dflt) {
} }
sexp sexp_list_to_vector(sexp ls) { sexp sexp_list_to_vector(sexp ls) {
sexp x, vec = sexp_make_vector(sexp_length(ls), SEXP_UNDEF); sexp x, vec = sexp_make_vector(sexp_length(ls), SEXP_VOID);
sexp *elts = sexp_vector_data(vec); sexp *elts = sexp_vector_data(vec);
int i; int i;
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x)) for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
@ -402,7 +402,7 @@ sexp sexp_list_to_vector(sexp ls) {
} }
sexp sexp_vector(int count, ...) { sexp sexp_vector(int count, ...) {
sexp vec = sexp_make_vector(sexp_make_integer(count), SEXP_UNDEF); sexp vec = sexp_make_vector(sexp_make_integer(count), SEXP_VOID);
sexp *elts = sexp_vector_data(vec); sexp *elts = sexp_vector_data(vec);
va_list ap; va_list ap;
int i; int i;
@ -443,7 +443,7 @@ int sstream_write (void *vec, const char *src, int n) {
pos = sexp_unbox_integer(sexp_stream_pos(vec)); pos = sexp_unbox_integer(sexp_stream_pos(vec));
newpos = pos+n; newpos = pos+n;
if (newpos > len) { if (newpos > len) {
newbuf = sexp_make_string(sexp_make_integer(len*2), SEXP_UNDEF); newbuf = sexp_make_string(sexp_make_integer(len*2), SEXP_VOID);
memcpy(sexp_string_data(newbuf), memcpy(sexp_string_data(newbuf),
sexp_string_data(sexp_stream_buf(vec)), sexp_string_data(sexp_stream_buf(vec)),
pos); pos);
@ -483,7 +483,7 @@ sexp sexp_make_output_string_port () {
FILE *out; FILE *out;
sexp res, size, cookie; sexp res, size, cookie;
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE); size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE);
cookie = sexp_vector(3, sexp_make_string(size, SEXP_UNDEF), cookie = sexp_vector(3, sexp_make_string(size, SEXP_VOID),
size, sexp_make_integer(0)); size, sexp_make_integer(0));
out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL); out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL);
res = sexp_make_output_port(out); res = sexp_make_output_port(out);
@ -708,8 +708,8 @@ void sexp_write (sexp obj, sexp out) {
sexp_write_string("#f", out); break; sexp_write_string("#f", out); break;
case (sexp_uint_t) SEXP_EOF: case (sexp_uint_t) SEXP_EOF:
sexp_write_string("#<eof>", out); break; sexp_write_string("#<eof>", out); break;
case (sexp_uint_t) SEXP_DEF:
case (sexp_uint_t) SEXP_UNDEF: case (sexp_uint_t) SEXP_UNDEF:
case (sexp_uint_t) SEXP_VOID:
sexp_write_string("#<undef>", out); break; sexp_write_string("#<undef>", out); break;
case (sexp_uint_t) SEXP_ERROR: case (sexp_uint_t) SEXP_ERROR:
sexp_write_string("#<error>", out); break; sexp_write_string("#<error>", out); break;

6
sexp.h
View file

@ -177,9 +177,9 @@ struct sexp_struct {
#define SEXP_FALSE SEXP_MAKE_IMMEDIATE(1) #define SEXP_FALSE SEXP_MAKE_IMMEDIATE(1)
#define SEXP_TRUE SEXP_MAKE_IMMEDIATE(2) #define SEXP_TRUE SEXP_MAKE_IMMEDIATE(2)
#define SEXP_EOF SEXP_MAKE_IMMEDIATE(3) #define SEXP_EOF SEXP_MAKE_IMMEDIATE(3)
#define SEXP_UNDEF SEXP_MAKE_IMMEDIATE(4) #define SEXP_VOID SEXP_MAKE_IMMEDIATE(4)
#define SEXP_ERROR SEXP_MAKE_IMMEDIATE(5) /* exceptions are preferred */ #define SEXP_ERROR SEXP_MAKE_IMMEDIATE(5) /* internal use */
#define SEXP_DEF SEXP_MAKE_IMMEDIATE(6) /* internal use */ #define SEXP_UNDEF SEXP_MAKE_IMMEDIATE(6) /* internal use */
#define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(7) /* internal use */ #define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(7) /* internal use */
#define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(8) /* internal use */ #define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(8) /* internal use */