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

adding explicit renaming macros and a bunch of library code

Browse source
This commit is contained in:
Alex Shinn 2009-04-01 02:44:53 +09:00
parent a0c78ad611
commit 63d337491a
8 changed files with 305 additions and 159 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -13,7 +13,7 @@ GC_OBJ=./gc/gc.a
sexp.o: sexp.c sexp.h config.h defaults.h Makefile sexp.o: sexp.c sexp.h config.h defaults.h Makefile
gcc -c $(CFLAGS) -o $@ $< gcc -c $(CFLAGS) -o $@ $<
eval.o: eval.c debug.c eval.h sexp.h config.h defaults.h Makefile eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile
gcc -c $(CFLAGS) -o $@ $< gcc -c $(CFLAGS) -o $@ $<
# main.o: main.c eval.h sexp.h config.h Makefile # main.o: main.c eval.h sexp.h config.h Makefile

14
debug.c
View file

@ -4,14 +4,14 @@
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", "EVAL", "JUMP_UNLESS", "JUMP", "FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "EVAL", "JUMP_UNLESS",
"PUSH", "DROP", "STACK_REF", "LOCAL_REF", "LOCAL_SET", "JUMP", "PUSH", "DROP", "STACK_REF", "LOCAL_REF", "LOCAL_SET",
"CLOSURE_REF", "VECTOR_REF", "VECTOR_SET", "STRING_REF", "STRING_SET", "CLOSURE_REF", "VECTOR_REF", "VECTOR_SET", "STRING_REF", "STRING_SET",
"MAKE_PROCEDURE", "MAKE_VECTOR", "NULLP", "INTEGERP", "MAKE_PROCEDURE", "MAKE_VECTOR", "NULLP", "INTEGERP", "SYMBOLP", "CHARP",
"SYMBOLP", "CHARP", "EOFP", "TYPEP", "EOFP", "TYPEP", "CAR", "CDR", "SET_CAR", "SET_CDR", "CONS", "ADD", "SUB",
"CAR", "CDR", "SET_CAR", "SET_CDR", "CONS", "ADD", "SUB", "MUL", "DIV", "MUL", "DIV", "QUOT", "MOD", "NEG", "INV", "LT", "LE", "EQV", "EQ",
"QUOT", "MOD", "NEG", "INV", "LT", "LE", "EQV", "EQ", "DISPLAY", "WRITE", "DISPLAY", "WRITE", "WRITE_CHAR", "NEWLINE", "FLUSH_OUTPUT", "READ",
"WRITE_CHAR", "NEWLINE", "FLUSH_OUTPUT", "READ", "READ_CHAR", "RET", "DONE", "READ_CHAR", "RET", "DONE",
}; };
void disasm (sexp bc, sexp out) { void disasm (sexp bc, sexp out) {

140
eval.c
View file

@ -88,7 +88,7 @@ static sexp env_global_ref(sexp e, sexp key, sexp dflt) {
static void env_define(sexp e, sexp key, sexp value) { static void env_define(sexp e, sexp key, sexp value) {
sexp cell = sexp_assq(key, sexp_env_bindings(e)); sexp cell = sexp_assq(key, sexp_env_bindings(e));
if (cell != SEXP_FALSE) if (cell != SEXP_FALSE)
sexp_cdar(cell) = value; sexp_cdr(cell) = value;
else else
sexp_push(sexp_env_bindings(e), sexp_cons(key, value)); sexp_push(sexp_env_bindings(e), sexp_cons(key, value));
} }
@ -278,6 +278,25 @@ static sexp sexp_identifierp (sexp x) {
return sexp_make_boolean(sexp_idp(x)); return sexp_make_boolean(sexp_idp(x));
} }
static sexp sexp_identifier_eq (sexp e1, sexp id1, sexp e2, sexp id2) {
sexp cell, lam1=SEXP_FALSE, lam2=SEXP_FALSE;
if (sexp_synclop(id1)) {
e1 = sexp_synclo_env(id1);
id1 = sexp_synclo_expr(id1);
}
if (sexp_synclop(id2)) {
e2 = sexp_synclo_env(id2);
id2 = sexp_synclo_expr(id2);
}
cell = env_cell(e1, id1);
if (sexp_lambdap(sexp_cdr(cell)))
lam1 = sexp_cdr(cell);
cell = env_cell(e2, id2);
if (sexp_lambdap(sexp_cdr(cell)))
lam2 = sexp_cdr(cell);
return sexp_make_boolean((id1 == id2) && (lam1 == lam2));
}
/************************* the compiler ***************************/ /************************* the compiler ***************************/
static sexp sexp_compile_error(char *message, sexp irritants) { static sexp sexp_compile_error(char *message, sexp irritants) {
@ -298,10 +317,14 @@ static sexp analyze (sexp x, sexp context) {
sexp op, cell, res; sexp op, cell, res;
loop: loop:
if (sexp_pairp(x)) { if (sexp_pairp(x)) {
if (! sexp_listp(x)) { if (sexp_listp(x) == SEXP_FALSE) {
res = sexp_compile_error("dotted list in source", sexp_list1(x)); res = sexp_compile_error("dotted list in source", sexp_list1(x));
} else if (sexp_idp(sexp_car(x))) { } else if (sexp_idp(sexp_car(x))) {
cell = env_cell(sexp_context_env(context), sexp_car(x)); if (sexp_synclop(sexp_car(x)))
cell = env_cell(sexp_synclo_env(sexp_car(x)),
sexp_synclo_expr(sexp_car(x)));
else
cell = env_cell(sexp_context_env(context), sexp_car(x));
if (! cell) return analyze_app(x, context); if (! cell) return analyze_app(x, context);
op = sexp_cdr(cell); op = sexp_cdr(cell);
if (sexp_corep(op)) { if (sexp_corep(op)) {
@ -365,7 +388,7 @@ static sexp analyze_lambda (sexp x, sexp context) {
if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x)))) if (! (sexp_pairp(sexp_cdr(x)) && sexp_pairp(sexp_cddr(x))))
return sexp_compile_error("bad lambda syntax", sexp_list1(x)); return sexp_compile_error("bad lambda syntax", sexp_list1(x));
for (ls=sexp_cadr(x); sexp_pairp(ls); ls=sexp_cdr(ls)) for (ls=sexp_cadr(x); sexp_pairp(ls); ls=sexp_cdr(ls))
if (! sexp_symbolp(sexp_car(ls))) if (! sexp_idp(sexp_car(ls)))
return sexp_compile_error("non-symbol parameter", sexp_list1(x)); return sexp_compile_error("non-symbol parameter", sexp_list1(x));
else if (sexp_memq(sexp_car(ls), sexp_cdr(ls)) != SEXP_FALSE) else if (sexp_memq(sexp_car(ls), sexp_cdr(ls)) != SEXP_FALSE)
return sexp_compile_error("duplicate parameter", sexp_list1(x)); return sexp_compile_error("duplicate parameter", sexp_list1(x));
@ -757,7 +780,8 @@ static void generate_lambda (sexp lambda, sexp context) {
} }
} }
generate(sexp_lambda_body(lambda), ctx); generate(sexp_lambda_body(lambda), ctx);
flags = sexp_make_integer(sexp_listp(sexp_lambda_params(lambda)) ? 0 : 1); flags = sexp_make_integer((sexp_listp(sexp_lambda_params(lambda))==SEXP_FALSE)
? 1 : 0);
len = sexp_length(sexp_lambda_params(lambda)); len = sexp_length(sexp_lambda_params(lambda));
bc = finalize_bytecode(ctx); bc = finalize_bytecode(ctx);
if (sexp_nullp(fv)) { if (sexp_nullp(fv)) {
@ -1404,91 +1428,9 @@ static struct sexp_struct core_forms[] = {
{.tag=SEXP_CORE, .value={.core={CORE_LETREC_SYNTAX, "letrec-syntax"}}}, {.tag=SEXP_CORE, .value={.core={CORE_LETREC_SYNTAX, "letrec-syntax"}}},
}; };
static struct sexp_struct opcodes[] = { #include "opcodes.c"
#define _OP(c,o,n,m,t,u,i,s,d,p) {.tag=SEXP_OPCODE, .value={.opcode={c, o, n, m, t, u, i, s, d, p}}}
#define _FN(o,n,t,u,s,f) _OP(OPC_FOREIGN, o, n, 0, t, u, 0, s, (sexp)f, NULL)
#define _FN0(s, f) _FN(OP_FCALL0, 0, 0, 0, s, f)
#define _FN1(t, s, f) _FN(OP_FCALL1, 1, t, 0, s, f)
#define _FN2(t, u, s, f) _FN(OP_FCALL2, 2, t, u, s, f)
#define _FN3(t, u, s, f) _FN(OP_FCALL3, 3, t, u, s, f)
#define _PARAM(n,a,t) _OP(OPC_PARAMETER, OP_NOOP, 0, 2, t, 0, 0, n, a, NULL)
_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", NULL, NULL),
_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", NULL, NULL),
_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", NULL, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", NULL, NULL),
_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", NULL, NULL),
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEG, "-", NULL, NULL),
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INV, "/", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_QUOT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_MOD, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "modulo", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 0, "<", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 0, "<=", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 1, ">", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 1, ">=", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_EQ, 0, 1, SEXP_FIXNUM, 0, 0, "=", NULL, NULL),
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 2, 0, SEXP_FIXNUM, 0, 0, "make-vector", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", (sexp)SEXP_PAIR, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", (sexp)SEXP_STRING, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", (sexp)SEXP_VECTOR, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "procedure?", (sexp)SEXP_PROCEDURE, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", (sexp)SEXP_IPORT, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", (sexp)SEXP_OPORT, NULL),
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", NULL, NULL),
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", NULL, NULL),
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error", NULL, NULL),
_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_FLUSH_OUTPUT, 0, 3, 0, SEXP_OPORT, 0, "flush-output", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_READ, 0, 3, 0, SEXP_IPORT, 0, "read", (sexp)"*current-input-port*", NULL),
_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
_OP(OPC_GENERIC, OP_EVAL, 1, 3, 0, 0, 0, "eval", (sexp)"*interaction-environment*", NULL),
_FN1(0, "identifier?", sexp_identifierp),
_FN1(SEXP_PAIR, "length", sexp_length),
_FN1(SEXP_PAIR, "reverse", sexp_reverse),
_FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector),
_FN1(SEXP_STRING, "open-input-file", sexp_open_input_file),
_FN1(SEXP_STRING, "open-output-file", sexp_open_output_file),
_FN1(SEXP_IPORT, "close-input-port", sexp_close_port),
_FN1(SEXP_OPORT, "close-output-port", sexp_close_port),
_FN1(SEXP_FIXNUM, "null-environment", sexp_make_null_env),
_FN1(SEXP_FIXNUM, "scheme-report-environment", sexp_make_standard_env),
_FN2(0, SEXP_ENV, "%load", sexp_load),
#if USE_MATH
_FN1(0, "exp", sexp_exp),
_FN1(0, "log", sexp_log),
_FN1(0, "sin", sexp_sin),
_FN1(0, "cos", sexp_cos),
_FN1(0, "tan", sexp_tan),
_FN1(0, "asin", sexp_asin),
_FN1(0, "acos", sexp_acos),
_FN1(0, "atan", sexp_atan),
_FN1(0, "sqrt", sexp_sqrt),
#endif
_FN2(0, SEXP_PAIR, "memq", sexp_memq),
_FN2(0, SEXP_PAIR, "assq", sexp_assq),
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", sexp_make_synclo),
_PARAM("current-input-port", (sexp)"*current-input-port*", SEXP_IPORT),
_PARAM("current-output-port", (sexp)"*current-output-port*", SEXP_OPORT),
_PARAM("current-error-port", (sexp)"*current-error-port*", SEXP_OPORT),
_PARAM("current-error-handler", (sexp)"*current-error-handler*", SEXP_PROCEDURE),
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
};
static sexp standard_env_syms_interned_p = 0; static int standard_env_syms_interned_p = 0;
static sexp sexp_make_null_env (sexp version) { static sexp sexp_make_null_env (sexp version) {
sexp_uint_t i; sexp_uint_t i;
@ -1502,16 +1444,17 @@ static sexp sexp_make_null_env (sexp version) {
static sexp sexp_make_standard_env (sexp version) { static sexp sexp_make_standard_env (sexp version) {
sexp_uint_t i; sexp_uint_t i;
sexp e = sexp_make_null_env(version), cell, sym; sexp e = sexp_make_null_env(version), op, cell, sym;
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) { for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
op = &opcodes[i];
if ((! standard_env_syms_interned_p) if ((! standard_env_syms_interned_p)
&& sexp_opcode_opt_param_p(&opcodes[i]) && sexp_opcode_opt_param_p(op)
&& sexp_opcode_data(&opcodes[i])) { && sexp_opcode_data(op)) {
sym = sexp_intern((char*)sexp_opcode_data(&opcodes[i])); sym = sexp_intern((char*)sexp_opcode_data(op));
cell = env_cell_create(e, sym, SEXP_UNDEF); cell = env_cell_create(e, sym, SEXP_UNDEF);
sexp_opcode_data(&opcodes[i]) = cell; sexp_opcode_data(op) = cell;
} }
env_define(e, sexp_intern(sexp_opcode_name(&opcodes[i])), &opcodes[i]); env_define(e, sexp_intern(sexp_opcode_name(op)), op);
} }
env_define(e, the_cur_in_symbol, sexp_make_input_port(stdin)); env_define(e, the_cur_in_symbol, sexp_make_input_port(stdin));
env_define(e, the_cur_out_symbol, sexp_make_output_port(stdout)); env_define(e, the_cur_out_symbol, sexp_make_output_port(stdout));
@ -1523,7 +1466,6 @@ static sexp sexp_make_standard_env (sexp version) {
/************************** eval interface ****************************/ /************************** eval interface ****************************/
/* args ... n ret-ip ret-cp ret-fp */
sexp apply(sexp proc, sexp args, sexp context) { sexp apply(sexp proc, sexp args, sexp context) {
sexp *stack = sexp_context_stack(context), ls; sexp *stack = sexp_context_stack(context), ls;
sexp_sint_t top = sexp_context_top(context), offset; sexp_sint_t top = sexp_context_top(context), offset;
@ -1558,9 +1500,9 @@ sexp compile (sexp x, sexp context) {
sexp eval_in_context (sexp obj, sexp context) { sexp eval_in_context (sexp obj, sexp context) {
sexp thunk = compile(obj, context); sexp thunk = compile(obj, context);
if (sexp_exceptionp(thunk)) { if (sexp_exceptionp(thunk)) {
sexp_print_exception(obj, 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_UNDEF;
} }
return apply(thunk, SEXP_NULL, context); return apply(thunk, SEXP_NULL, context);

1
eval.h
View file

@ -68,6 +68,7 @@ enum opcode_names {
OP_FCALL1, OP_FCALL1,
OP_FCALL2, OP_FCALL2,
OP_FCALL3, OP_FCALL3,
OP_FCALL4,
OP_EVAL, OP_EVAL,
OP_JUMP_UNLESS, OP_JUMP_UNLESS,
OP_JUMP, OP_JUMP,

135
init.scm
View file

@ -1,22 +1,21 @@
;; let* cond case delay and do ;; cond case delay do
;; quasiquote let-syntax ;; quasiquote let-syntax
;; letrec-syntax syntax-rules eqv? equal? not boolean? number? ;; letrec-syntax syntax-rules not boolean? number?
;; complex? real? rational? integer? exact? inexact? ;; complex? real? rational? integer? exact? inexact?
;; positive? negative? odd? even? max min quotient remainder ;; positive? negative? odd? even? max min quotient remainder
;; modulo numerator denominator floor ceiling truncate round ;; modulo numerator denominator floor ceiling truncate round
;; rationalize sqrt expt ;; rationalize expt
;; make-rectangular make-polar real-part imag-part magnitude angle ;; make-rectangular make-polar real-part imag-part magnitude angle
;; exact->inexact inexact->exact number->string string->number ;; exact->inexact inexact->exact number->string string->number
;; list? list-tail list-ref memv ;; symbol->string string->symbol
;; member assv assoc symbol->string string->symbol
;; char-alphabetic? char-numeric? char-whitespace? ;; char-alphabetic? char-numeric? char-whitespace?
;; char-upper-case? char-lower-case? char->integer integer->char ;; char-upper-case? char-lower-case? char->integer integer->char
;; char-upcase char-downcase make-string string string-length ;; char-upcase char-downcase make-string string string-length
;; string=? string-ci=? string<? string>? ;; string=? string-ci=? string<? string>?
;; string<=? string>=? string-ci<? string-ci>? string-ci<=? string-ci>=? ;; string<=? string>=? string-ci<? string-ci>? string-ci<=? string-ci>=?
;; substring string-append string->list list->string string-copy ;; substring string-append string->list list->string string-copy
;; string-fill! make-vector vector vector-length ;; string-fill! vector vector-length
;; vector->list list->vector vector-fill! procedure? apply ;; vector->list list->vector vector-fill! procedure? apply
;; map for-each force call-with-current-continuation values ;; map for-each force call-with-current-continuation values
;; call-with-values dynamic-wind scheme-report-environment ;; call-with-values dynamic-wind scheme-report-environment
@ -24,8 +23,7 @@
;; current-input-port current-output-port ;; current-input-port current-output-port
;; with-input-from-file with-output-to-file open-input-file ;; with-input-from-file with-output-to-file open-input-file
;; open-output-file close-input-port close-output-port ;; open-output-file close-input-port close-output-port
;; peek-char eof-object? char-ready? ;; peek-char char-ready?
;; eval
;; provide c[ad]{2,4}r ;; provide c[ad]{2,4}r
@ -34,14 +32,14 @@
(define (cdar x) (cdr (car x))) (define (cdar x) (cdr (car x)))
(define (cddr x) (cdr (cdr x))) (define (cddr x) (cdr (cdr x)))
;; (define (caaar x) (car (car (car x)))) (define (caaar x) (car (car (car x))))
;; (define (caadr x) (car (car (cdr x)))) (define (caadr x) (car (car (cdr x))))
;; (define (cadar x) (car (cdr (car x)))) (define (cadar x) (car (cdr (car x))))
;; (define (caddr x) (car (cdr (cdr x)))) (define (caddr x) (car (cdr (cdr x))))
;; (define (cdaar x) (cdr (car (car x)))) (define (cdaar x) (cdr (car (car x))))
;; (define (cdadr x) (cdr (car (cdr x)))) (define (cdadr x) (cdr (car (cdr x))))
;; (define (cddar x) (cdr (cdr (car x)))) (define (cddar x) (cdr (cdr (car x))))
;; (define (cdddr x) (cdr (cdr (cdr x)))) (define (cdddr x) (cdr (cdr (cdr x))))
;; (define (caaaar x) (car (car (car (car x))))) ;; (define (caaaar x) (car (car (car (car x)))))
;; (define (caaadr x) (car (car (car (cdr x))))) ;; (define (caaadr x) (car (car (car (cdr x)))))
@ -62,6 +60,33 @@
(define (list . args) args) (define (list . args) args)
(define (list-tail ls k)
(if (zero? k)
ls
(list-tail (cdr ls) (- k 1))))
(define (list-ref ls k) (car (list-tail ls k)))
(define eqv? equal?)
(define (member obj ls)
(if (null? ls)
#f
(if (equal? obj (car ls))
ls
(member obj (cdr ls)))))
(define memv member)
(define (assoc obj ls)
(if (null? ls)
#f
(if (equal? obj (caar ls))
ls
(member obj (cdr ls)))))
(define assv assoc)
(define (append-reverse a b) (define (append-reverse a b)
(if (pair? a) (if (pair? a)
(append-reverse (cdr a) (cons (car a) b)) (append-reverse (cdr a) (cons (car a) b))
@ -114,30 +139,74 @@
(lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
(make-syntactic-closure use-env '() (f expr mac-env))))) (make-syntactic-closure use-env '() (f expr mac-env)))))
(define-syntax let (define er-macro-transformer
(lambda (expr use-env mac-env) (lambda (f)
(cons (cons 'lambda (cons (map car (cadr expr)) (cddr expr))) (lambda (expr use-env mac-env)
(map cadr (cadr expr))))) ((lambda (rename compare) (f expr rename compare))
((lambda (renames)
(lambda (identifier)
((lambda (cell)
(if cell
(cdr cell)
((lambda (name)
(set! renames (cons (cons identifier name) renames))
name)
(make-syntactic-closure mac-env '() identifier))))
(assq identifier renames))))
'())
(lambda (x y) (identifier=? use-env x use-env y))))))
(define-syntax letrec (define-syntax letrec
(lambda (expr use-env mac-env) (er-macro-transformer
(list (lambda (expr rename compare)
(cons 'lambda (list
(cons '() (cons (rename 'lambda)
(append (map (lambda (x) (cons 'define x)) (cadr expr)) (cons '()
(cddr expr))))))) (append (map (lambda (x) (cons (rename 'define) x)) (cadr expr))
(cddr expr))))))))
(define-syntax let
(er-macro-transformer
(lambda (expr rename compare)
(if (identifier? (cadr expr))
(list (rename 'letrec)
(list (list (cadr expr)
(cons (rename 'lambda)
(cons (map car (caddr expr))
(cdddr expr)))))
(cons (cadr expr) (map cadr (caddr expr))))
(cons (cons (rename 'lambda) (cons (map car (cadr expr)) (cddr expr)))
(map cadr (cadr expr)))))))
(define-syntax let*
(er-macro-transformer
(lambda (expr rename compare)
(if (null? (cadr expr))
(cons (rename 'begin) (cddr expr))
(list (rename 'let)
(list (caadr expr))
(cons (rename 'let*) (cons (cdadr expr) (cddr expr))))))))
(define-syntax or (define-syntax or
(sc-macro-transformer (er-macro-transformer
(lambda (expr use-env) (lambda (expr rename compare)
(if (null? (cdr expr)) (if (null? (cdr expr))
#f #f
(list (rename 'let) (list (list (rename 'tmp) (cadr expr)))
(list (rename 'if) (rename 'tmp)
(rename 'tmp)
(cons (rename 'or) (cddr expr))))))))
(define-syntax and
(er-macro-transformer
(lambda (expr rename compare)
(if (null? (cdr expr))
#t
(if (null? (cddr expr)) (if (null? (cddr expr))
(make-syntactic-closure use-env '() (cadr expr)) (cadr expr)
(list 'let (list (list 'tmp (make-syntactic-closure use-env '() (cadr expr)))) (list (rename 'if) (cadr expr)
(list 'if 'tmp (cons (rename 'and) (cddr expr))
'tmp #f))))))
(make-syntactic-closure use-env '() (cons 'or (cddr expr))))))))))
;; char utils ;; char utils

90
opcodes.c Normal file
View file

@ -0,0 +1,90 @@
#define _OP(c,o,n,m,t,u,i,s,d,p) {.tag=SEXP_OPCODE, .value={.opcode={c, o, n, m, t, u, i, s, d, p}}}
#define _FN(o,n,t,u,s,f) _OP(OPC_FOREIGN, o, n, 0, t, u, 0, s, (sexp)f, NULL)
#define _FN0(s, f) _FN(OP_FCALL0, 0, 0, 0, s, f)
#define _FN1(t, s, f) _FN(OP_FCALL1, 1, t, 0, s, f)
#define _FN2(t, u, s, f) _FN(OP_FCALL2, 2, t, u, s, f)
#define _FN3(t, u, s, f) _FN(OP_FCALL3, 3, t, u, s, f)
#define _FN4(t, u, s, f) _FN(OP_FCALL4, 4, t, u, s, f)
#define _PARAM(n,a,t) _OP(OPC_PARAMETER, OP_NOOP, 0, 2, t, 0, 0, n, a, NULL)
static struct sexp_struct opcodes[] = {
_OP(OPC_ACCESSOR, OP_CAR, 1, 0, SEXP_PAIR, 0, 0, "car", NULL, NULL),
_OP(OPC_ACCESSOR, OP_SET_CAR, 2, 0, SEXP_PAIR, 0, 0, "set-car!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_CDR, 1, 0, SEXP_PAIR, 0, 0, "cdr", NULL, NULL),
_OP(OPC_ACCESSOR, OP_SET_CDR, 2, 0, SEXP_PAIR, 0, 0, "set-cdr!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_REF,2,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-ref", NULL, NULL),
_OP(OPC_ACCESSOR, OP_VECTOR_SET,3,0, SEXP_VECTOR, SEXP_FIXNUM, 0,"vector-set!", NULL, NULL),
_OP(OPC_ACCESSOR, OP_STRING_REF,2,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-ref", NULL, NULL),
_OP(OPC_ACCESSOR, OP_STRING_SET,3,0, SEXP_STRING, SEXP_FIXNUM, 0,"string-set!", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_ADD, 0, 1, SEXP_FIXNUM, 0, 0, "+", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_MUL, 0, 1, SEXP_FIXNUM, 0, 0, "*", NULL, NULL),
_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, OP_NEG, "-", NULL, NULL),
_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, OP_INV, "/", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_QUOT, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "quotient", NULL, NULL),
_OP(OPC_ARITHMETIC, OP_MOD, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, 0, "modulo", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 0, "<", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 0, "<=", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LT, 0, 1, SEXP_FIXNUM, 0, 1, ">", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_LE, 0, 1, SEXP_FIXNUM, 0, 1, ">=", NULL, NULL),
_OP(OPC_ARITHMETIC_CMP, OP_EQ, 0, 1, SEXP_FIXNUM, 0, 0, "=", NULL, NULL),
_OP(OPC_PREDICATE, OP_EQ, 2, 0, 0, 0, 0, "eq?", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_CONS, 2, 0, 0, 0, 0, "cons", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_VECTOR, 2, 0, SEXP_FIXNUM, 0, 0, "make-vector", NULL, NULL),
_OP(OPC_CONSTRUCTOR, OP_MAKE_PROCEDURE, 4, 0, 0, 0, 0, "make-procedure", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_NULLP, 1, 0, 0, 0, 0, "null?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_EOFP, 1, 0, 0, 0, 0, "eof-object?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_SYMBOLP, 1, 0, 0, 0, 0, "symbol?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_CHARP, 1, 0, 0, 0, 0, "char?", NULL, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "pair?", (sexp)SEXP_PAIR, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "string?", (sexp)SEXP_STRING, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "vector?", (sexp)SEXP_VECTOR, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "procedure?", (sexp)SEXP_PROCEDURE, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", (sexp)SEXP_IPORT, NULL),
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", (sexp)SEXP_OPORT, NULL),
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", NULL, NULL),
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", NULL, NULL),
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error", NULL, NULL),
_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_FLUSH_OUTPUT, 0, 3, 0, SEXP_OPORT, 0, "flush-output", (sexp)"*current-output-port*", NULL),
_OP(OPC_IO, OP_READ, 0, 3, 0, SEXP_IPORT, 0, "read", (sexp)"*current-input-port*", NULL),
_OP(OPC_IO, OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
_OP(OPC_GENERIC, OP_EVAL, 1, 3, 0, 0, 0, "eval", (sexp)"*interaction-environment*", NULL),
_FN2(0, 0, "equal?", sexp_equalp),
_FN1(0, "list?", sexp_listp),
_FN1(0, "identifier?", sexp_identifierp),
_FN4(0, SEXP_ENV, "identifier=?", sexp_identifier_eq),
_FN1(SEXP_PAIR, "length", sexp_length),
_FN1(SEXP_PAIR, "reverse", sexp_reverse),
_FN1(SEXP_PAIR, "list->vector", sexp_list_to_vector),
_FN1(SEXP_STRING, "open-input-file", sexp_open_input_file),
_FN1(SEXP_STRING, "open-output-file", sexp_open_output_file),
_FN1(SEXP_IPORT, "close-input-port", sexp_close_port),
_FN1(SEXP_OPORT, "close-output-port", sexp_close_port),
_FN1(SEXP_FIXNUM, "null-environment", sexp_make_null_env),
_FN1(SEXP_FIXNUM, "scheme-report-environment", sexp_make_standard_env),
_FN2(0, SEXP_ENV, "%load", sexp_load),
#if USE_MATH
_FN1(0, "exp", sexp_exp),
_FN1(0, "log", sexp_log),
_FN1(0, "sin", sexp_sin),
_FN1(0, "cos", sexp_cos),
_FN1(0, "tan", sexp_tan),
_FN1(0, "asin", sexp_asin),
_FN1(0, "acos", sexp_acos),
_FN1(0, "atan", sexp_atan),
_FN1(0, "sqrt", sexp_sqrt),
#endif
_FN2(0, SEXP_PAIR, "memq", sexp_memq),
_FN2(0, SEXP_PAIR, "assq", sexp_assq),
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", sexp_make_synclo),
_PARAM("current-input-port", (sexp)"*current-input-port*", SEXP_IPORT),
_PARAM("current-output-port", (sexp)"*current-output-port*", SEXP_OPORT),
_PARAM("current-error-port", (sexp)"*current-error-port*", SEXP_OPORT),
_PARAM("current-error-handler", (sexp)"*current-error-handler*", SEXP_PROCEDURE),
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
};

76
sexp.c
View file

@ -91,8 +91,8 @@ void sexp_deep_free (sexp obj) {
/***************************** exceptions *****************************/ /***************************** exceptions *****************************/
sexp sexp_make_exception(sexp kind, sexp message, sexp irritants, sexp sexp_make_exception (sexp kind, sexp message, sexp irritants,
sexp file, sexp line) { sexp file, sexp line) {
sexp exn = sexp_alloc_type(exception, SEXP_EXCEPTION); sexp exn = sexp_alloc_type(exception, SEXP_EXCEPTION);
sexp_exception_kind(exn) = kind; sexp_exception_kind(exn) = kind;
sexp_exception_message(exn) = message; sexp_exception_message(exn) = message;
@ -102,11 +102,11 @@ sexp sexp_make_exception(sexp kind, sexp message, sexp irritants,
return exn; return exn;
} }
sexp sexp_print_exception(sexp exn, sexp out) { sexp sexp_print_exception (sexp exn, sexp out) {
sexp ls; sexp ls;
sexp_write_string("ERROR", out); sexp_write_string("ERROR", out);
if (sexp_integerp(sexp_exception_line(exn)) if (sexp_integerp(sexp_exception_line(exn))
&& sexp_exception_line(exn) > sexp_make_integer(0)) { && (sexp_exception_line(exn) > sexp_make_integer(0))) {
sexp_write_string(" on line ", out); sexp_write_string(" on line ", out);
sexp_write(sexp_exception_line(exn), out); sexp_write(sexp_exception_line(exn), out);
} }
@ -116,7 +116,8 @@ sexp sexp_print_exception(sexp exn, sexp out) {
} }
sexp_write_string(": ", out); sexp_write_string(": ", out);
sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out); sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out);
if (sexp_pairp(sexp_exception_irritants(exn))) { if (sexp_exception_irritants(exn)
&& sexp_pairp(sexp_exception_irritants(exn))) {
if (sexp_nullp(sexp_cdr(sexp_exception_irritants(exn)))) { if (sexp_nullp(sexp_cdr(sexp_exception_irritants(exn)))) {
sexp_write_string(": ", out); sexp_write_string(": ", out);
sexp_write(sexp_car(sexp_exception_irritants(exn)), out); sexp_write(sexp_car(sexp_exception_irritants(exn)), out);
@ -136,7 +137,7 @@ sexp sexp_print_exception(sexp exn, sexp out) {
return SEXP_UNDEF; return SEXP_UNDEF;
} }
static sexp sexp_read_error(char *message, sexp irritants, sexp port) { static sexp sexp_read_error (char *message, sexp irritants, sexp port) {
sexp name = (sexp_port_name(port) sexp name = (sexp_port_name(port)
? sexp_make_string(sexp_port_name(port)) : SEXP_FALSE); ? sexp_make_string(sexp_port_name(port)) : SEXP_FALSE);
return sexp_make_exception(the_read_error_symbol, return sexp_make_exception(the_read_error_symbol,
@ -148,17 +149,17 @@ static sexp sexp_read_error(char *message, sexp irritants, sexp port) {
/*************************** list utilities ***************************/ /*************************** list utilities ***************************/
sexp sexp_cons(sexp head, sexp tail) { sexp sexp_cons (sexp head, sexp tail) {
sexp pair = sexp_alloc_type(pair, SEXP_PAIR); sexp pair = sexp_alloc_type(pair, SEXP_PAIR);
sexp_car(pair) = head; sexp_car(pair) = head;
sexp_cdr(pair) = tail; sexp_cdr(pair) = tail;
return pair; return pair;
} }
int sexp_listp (sexp obj) { sexp sexp_listp (sexp obj) {
while (sexp_pairp(obj)) while (sexp_pairp(obj))
obj = sexp_cdr(obj); obj = sexp_cdr(obj);
return (obj == SEXP_NULL); return sexp_make_boolean(obj == SEXP_NULL);
} }
sexp sexp_memq (sexp x, sexp ls) { sexp sexp_memq (sexp x, sexp ls) {
@ -172,21 +173,21 @@ sexp sexp_memq (sexp x, sexp ls) {
sexp sexp_assq (sexp x, sexp ls) { sexp sexp_assq (sexp x, sexp ls) {
while (sexp_pairp(ls)) while (sexp_pairp(ls))
if (x == sexp_caar(ls)) if (sexp_pairp(sexp_car(ls)) && (x == sexp_caar(ls)))
return ls; return sexp_car(ls);
else else
ls = sexp_cdr(ls); ls = sexp_cdr(ls);
return SEXP_FALSE; return SEXP_FALSE;
} }
sexp sexp_reverse(sexp ls) { sexp sexp_reverse (sexp ls) {
sexp res = SEXP_NULL; sexp res = SEXP_NULL;
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
res = sexp_cons(sexp_car(ls), res); res = sexp_cons(sexp_car(ls), res);
return res; return res;
} }
sexp sexp_nreverse(sexp ls) { sexp sexp_nreverse (sexp ls) {
sexp a, b, tmp; sexp a, b, tmp;
if (ls == SEXP_NULL) { if (ls == SEXP_NULL) {
return ls; return ls;
@ -204,19 +205,62 @@ sexp sexp_nreverse(sexp ls) {
} }
} }
sexp sexp_append(sexp a, sexp b) { sexp sexp_append (sexp a, sexp b) {
for (a=sexp_reverse(a); sexp_pairp(a); a=sexp_cdr(a)) for (a=sexp_reverse(a); sexp_pairp(a); a=sexp_cdr(a))
b = sexp_cons(sexp_car(a), b); b = sexp_cons(sexp_car(a), b);
return b; return b;
} }
sexp sexp_length(sexp ls) { sexp sexp_length (sexp ls) {
sexp_uint_t res=0; 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); return sexp_make_integer(res);
} }
sexp sexp_equalp (sexp a, sexp b) {
sexp_uint_t len;
sexp *v1, *v2;
loop:
if (a == b)
return SEXP_TRUE;
if (! sexp_pointerp(a))
return sexp_make_boolean(sexp_integerp(a) && sexp_pointerp(b)
&& (sexp_unbox_integer(a)
== sexp_flonum_value(b)));
else if (! sexp_pointerp(b))
return sexp_make_boolean(sexp_integerp(b) && sexp_pointerp(a)
&& (sexp_unbox_integer(b)
== sexp_flonum_value(a)));
if (sexp_pointer_tag(a) != sexp_pointer_tag(b))
return SEXP_FALSE;
switch (sexp_pointer_tag(a)) {
case SEXP_PAIR:
if (sexp_equalp(sexp_car(a), sexp_car(b)) == SEXP_FALSE)
return SEXP_FALSE;
a = sexp_cdr(a);
b = sexp_cdr(b);
goto loop;
case SEXP_VECTOR:
len = sexp_vector_length(a);
if (len != sexp_vector_length(b))
return SEXP_FALSE;
v1 = sexp_vector_data(a);
v2 = sexp_vector_data(b);
for (len--; len >= 0; len--)
if (sexp_equalp(v1[len], v2[len]) == SEXP_FALSE)
return SEXP_FALSE;
return SEXP_TRUE;
case SEXP_STRING:
return sexp_make_boolean((sexp_string_length(a) == sexp_string_length(b))
&& (! strncmp(sexp_string_data(a),
sexp_string_data(b),
sexp_string_length(a))));
default:
return SEXP_FALSE;
}
}
/********************* strings, symbols, vectors **********************/ /********************* strings, symbols, vectors **********************/
sexp sexp_make_flonum(double f) { sexp sexp_make_flonum(double f) {
@ -805,7 +849,7 @@ sexp sexp_read_raw (sexp in) {
case '(': case '(':
sexp_push_char(c1, in); sexp_push_char(c1, in);
res = sexp_read(in); res = sexp_read(in);
if (! sexp_listp(res)) { if (sexp_listp(res) == SEXP_FALSE) {
if (! sexp_exceptionp(res)) { if (! sexp_exceptionp(res)) {
sexp_deep_free(res); sexp_deep_free(res);
res = sexp_read_error("dotted list not allowed in vector syntax", res = sexp_read_error("dotted list not allowed in vector syntax",

6
sexp.h
View file

@ -153,7 +153,7 @@ struct sexp_struct {
} lit; } lit;
/* compiler state */ /* compiler state */
struct { struct {
sexp bc, lambda, offsets, *stack, env; sexp bc, lambda, *stack, env;
sexp_uint_t pos, top, depth, tailp; sexp_uint_t pos, top, depth, tailp;
} context; } context;
} value; } value;
@ -326,7 +326,6 @@ struct sexp_struct {
#define sexp_context_pos(x) ((x)->value.context.pos) #define sexp_context_pos(x) ((x)->value.context.pos)
#define sexp_context_top(x) ((x)->value.context.top) #define sexp_context_top(x) ((x)->value.context.top)
#define sexp_context_lambda(x) ((x)->value.context.lambda) #define sexp_context_lambda(x) ((x)->value.context.lambda)
#define sexp_context_offsets(x) ((x)->value.context.offsets)
#define sexp_context_tailp(x) ((x)->value.context.tailp) #define sexp_context_tailp(x) ((x)->value.context.tailp)
/****************************** arithmetic ****************************/ /****************************** arithmetic ****************************/
@ -400,7 +399,8 @@ void sexp_printf(sexp port, sexp fmt, ...);
sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag); sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag);
sexp sexp_cons(sexp head, sexp tail); sexp sexp_cons(sexp head, sexp tail);
int sexp_listp(sexp obj); sexp sexp_equalp (sexp a, sexp b);
sexp sexp_listp(sexp obj);
sexp sexp_reverse(sexp ls); sexp sexp_reverse(sexp ls);
sexp sexp_nreverse(sexp ls); sexp sexp_nreverse(sexp ls);
sexp sexp_append(sexp a, sexp b); sexp sexp_append(sexp a, sexp b);