mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-07 13:16:36 +02:00
new primitives API
Primitives now have a signature of prim(ctx, self, n, args ...) instead of just prim(ctx, args ...). This allows for variadic primitives, should help clean up exception handling, and will allow primitives generated from Scheme->C or JIT compilation. The primitives sometimes used as utility functions from C such as sexp_memq have been renamed with a "_op" suffix (e.g. sexp_memq_op) and a macro sexp_memq has been provided filling in the self and n args automatically. The self is passed as NULL in these macros, but will be probably replaced with a reference to the opcode later.
This commit is contained in:
Alex Shinn
parent
36043bb8da
commit
a89956fc16
9 changed files with 283 additions and 214 deletions
18
Makefile
18
Makefile
|
|
@ -129,11 +129,11 @@ chibi-scheme-static$(EXE): main.o eval.o sexp.o
|
|||
clibs.c: $(GENSTATIC) lib lib/chibi lib/srfi
|
||||
make chibi-scheme$(EXE)
|
||||
make libs
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) PATH=.:$(PATH) $(GENSTATIC) $< > $@
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" PATH=".:$(PATH)" $(GENSTATIC) $< > $@
|
||||
|
||||
%.c: %.stub $(GENSTUBS)
|
||||
make chibi-scheme$(EXE)
|
||||
-LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) PATH=.:$(PATH) $(GENSTUBS) $<
|
||||
-LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" PATH=".:$(PATH)" $(GENSTUBS) $<
|
||||
|
||||
lib/%$(SO): lib/%.c $(INCLUDES)
|
||||
-$(CC) $(CLIBFLAGS) $(XCPPFLAGS) $(XCFLAGS) -o $@ $< -L. -lchibi-scheme
|
||||
|
|
@ -149,7 +149,7 @@ cleaner: clean
|
|||
|
||||
test-basic: chibi-scheme$(EXE)
|
||||
@for f in tests/basic/*.scm; do \
|
||||
./chibi-scheme$(EXE) $$f >$${f%.scm}.out 2>$${f%.scm}.err; \
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) $$f >$${f%.scm}.out 2>$${f%.scm}.err; \
|
||||
if diff -q $(DIFFOPTS) $${f%.scm}.out $${f%.scm}.res; then \
|
||||
echo "[PASS] $${f%.scm}"; \
|
||||
else \
|
||||
|
|
@ -161,22 +161,22 @@ test-build:
|
|||
./tests/build/build-tests.sh
|
||||
|
||||
test-numbers: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/numeric-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/numeric-tests.scm
|
||||
|
||||
test-hash: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/hash-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/hash-tests.scm
|
||||
|
||||
test-match: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/match-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/match-tests.scm
|
||||
|
||||
test-loop: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/loop-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/loop-tests.scm
|
||||
|
||||
test-sort: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/sort-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/sort-tests.scm
|
||||
|
||||
test: chibi-scheme$(EXE)
|
||||
LD_LIBRARY_PATH=.:$(LD_LIBRARY_PATH) ./chibi-scheme$(EXE) tests/r5rs-tests.scm
|
||||
LD_LIBRARY_PATH=".:$(LD_LIBRARY_PATH)" ./chibi-scheme$(EXE) tests/r5rs-tests.scm
|
||||
|
||||
install: chibi-scheme$(EXE)
|
||||
mkdir -p $(DESTDIR)$(BINDIR)
|
||||
|
|
|
|||
76
eval.c
76
eval.c
|
|
@ -1,5 +1,5 @@
|
|||
/* eval.c -- evaluator library implementation */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "chibi/eval.h"
|
||||
|
|
@ -24,8 +24,8 @@ static sexp analyze (sexp ctx, sexp x);
|
|||
static void generate (sexp ctx, sexp x);
|
||||
|
||||
#if SEXP_USE_MODULES
|
||||
static sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env);
|
||||
static sexp sexp_find_module_file_op (sexp ctx, sexp file);
|
||||
static sexp sexp_load_module_file_op (sexp ctx sexp_api_params(self, n), sexp file, sexp env);
|
||||
static sexp sexp_find_module_file_op (sexp ctx sexp_api_params(self, n), sexp file);
|
||||
#endif
|
||||
|
||||
sexp sexp_compile_error (sexp ctx, const char *message, sexp o) {
|
||||
|
|
@ -110,7 +110,7 @@ sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_env_exports (sexp ctx, sexp env) {
|
||||
sexp sexp_env_exports_op (sexp ctx sexp_api_params(self, n), sexp env) {
|
||||
sexp ls;
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
|
|
@ -251,7 +251,7 @@ static sexp sexp_make_macro (sexp ctx, sexp p, sexp e) {
|
|||
return mac;
|
||||
}
|
||||
|
||||
static sexp sexp_make_synclo (sexp ctx, sexp env, sexp fv, sexp expr) {
|
||||
static sexp sexp_make_synclo_op (sexp ctx sexp_api_params(self, n), sexp env, sexp fv, sexp expr) {
|
||||
sexp res;
|
||||
if (! (sexp_symbolp(expr) || sexp_pairp(expr)))
|
||||
return expr;
|
||||
|
|
@ -382,11 +382,11 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) {
|
|||
|
||||
/**************************** identifiers *****************************/
|
||||
|
||||
static sexp sexp_identifierp (sexp ctx, sexp x) {
|
||||
static sexp sexp_identifierp_op (sexp ctx sexp_api_params(self, n), sexp x) {
|
||||
return sexp_make_boolean(sexp_idp(x));
|
||||
}
|
||||
|
||||
static sexp sexp_syntactic_closure_expr (sexp ctx, sexp x) {
|
||||
static sexp sexp_syntactic_closure_expr_op (sexp ctx sexp_api_params(self, n), sexp x) {
|
||||
return (sexp_synclop(x) ? sexp_synclo_expr(x) : x);
|
||||
}
|
||||
|
||||
|
|
@ -410,7 +410,7 @@ static sexp sexp_strip_synclos (sexp ctx, sexp x) {
|
|||
return res;
|
||||
}
|
||||
|
||||
static sexp sexp_identifier_eq (sexp ctx, sexp e1, sexp id1, sexp e2, sexp id2) {
|
||||
static sexp sexp_identifier_eq_op (sexp ctx sexp_api_params(self, n), 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);
|
||||
|
|
@ -1441,21 +1441,21 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case SEXP_OP_FCALL0:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_PUSH(((sexp_proc1)sexp_opcode_func(_WORD0))(ctx));
|
||||
_PUSH(((sexp_proc1)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 0)));
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case SEXP_OP_FCALL1:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx, _ARG1);
|
||||
_ARG1 = ((sexp_proc2)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 1), _ARG1);
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case SEXP_OP_FCALL2:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG2 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2);
|
||||
_ARG2 = ((sexp_proc3)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 2), _ARG1, _ARG2);
|
||||
top--;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -1463,7 +1463,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case SEXP_OP_FCALL3:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG3 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3);
|
||||
_ARG3 = ((sexp_proc4)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 3), _ARG1, _ARG2, _ARG3);
|
||||
top -= 2;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -1471,7 +1471,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case SEXP_OP_FCALL4:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG4 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4);
|
||||
_ARG4 = ((sexp_proc5)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 4), _ARG1, _ARG2, _ARG3, _ARG4);
|
||||
top -= 3;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -1479,7 +1479,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case SEXP_OP_FCALL5:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG5 = ((sexp_proc6)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
|
||||
_ARG5 = ((sexp_proc6)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 5), _ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
|
||||
top -= 4;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -1487,7 +1487,7 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
case SEXP_OP_FCALL6:
|
||||
_ALIGN_IP();
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG6 = ((sexp_proc7)sexp_opcode_func(_WORD0))(ctx, _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6);
|
||||
_ARG6 = ((sexp_proc7)sexp_opcode_func(_WORD0))(ctx sexp_api_pass(_WORD0, 6), _ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6);
|
||||
top -= 5;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
|
|
@ -2025,14 +2025,14 @@ sexp sexp_vm (sexp ctx, sexp proc) {
|
|||
|
||||
/************************ library procedures **************************/
|
||||
|
||||
static sexp sexp_exception_type_func (sexp ctx, sexp exn) {
|
||||
static sexp sexp_exception_type_op (sexp ctx sexp_api_params(self, n), sexp exn) {
|
||||
if (sexp_exceptionp(exn))
|
||||
return sexp_exception_kind(exn);
|
||||
else
|
||||
return sexp_type_exception(ctx, "not an exception", exn);
|
||||
}
|
||||
|
||||
static sexp sexp_open_input_file (sexp ctx, sexp path) {
|
||||
static sexp sexp_open_input_file_op (sexp ctx sexp_api_params(self, n), sexp path) {
|
||||
FILE *in;
|
||||
if (! sexp_stringp(path))
|
||||
return sexp_type_exception(ctx, "not a string", path);
|
||||
|
|
@ -2043,7 +2043,7 @@ static sexp sexp_open_input_file (sexp ctx, sexp path) {
|
|||
return sexp_make_input_port(ctx, in, path);
|
||||
}
|
||||
|
||||
static sexp sexp_open_output_file (sexp ctx, sexp path) {
|
||||
static sexp sexp_open_output_file_op (sexp ctx sexp_api_params(self, n), sexp path) {
|
||||
FILE *out;
|
||||
if (! sexp_stringp(path))
|
||||
return sexp_type_exception(ctx, "not a string", path);
|
||||
|
|
@ -2054,12 +2054,12 @@ static sexp sexp_open_output_file (sexp ctx, sexp path) {
|
|||
return sexp_make_output_port(ctx, out, path);
|
||||
}
|
||||
|
||||
static sexp sexp_close_port (sexp ctx, sexp port) {
|
||||
static sexp sexp_close_port_op (sexp ctx sexp_api_params(self, n), sexp port) {
|
||||
if (! sexp_portp(port))
|
||||
return sexp_type_exception(ctx, "not a port", port);
|
||||
if (! sexp_port_openp(port))
|
||||
return sexp_user_exception(ctx, SEXP_FALSE, "port already closed", port);
|
||||
return sexp_finalize_port(ctx, port);
|
||||
return sexp_finalize_port(ctx sexp_api_pass(self, n), port);
|
||||
}
|
||||
|
||||
void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) {
|
||||
|
|
@ -2085,7 +2085,7 @@ static sexp sexp_load_dl (sexp ctx, sexp file, sexp env) {
|
|||
FreeLibrary(handle);
|
||||
return sexp_compile_error(ctx, "dynamic library has no sexp_init_library", file);
|
||||
}
|
||||
return init(ctx, env);
|
||||
return init(ctx sexp_api_pass(NULL, 1), env);
|
||||
}
|
||||
#else
|
||||
static sexp sexp_load_dl (sexp ctx, sexp file, sexp env) {
|
||||
|
|
@ -2098,12 +2098,12 @@ static sexp sexp_load_dl (sexp ctx, sexp file, sexp env) {
|
|||
dlclose(handle);
|
||||
return sexp_compile_error(ctx, "dynamic library has no sexp_init_library", file);
|
||||
}
|
||||
return init(ctx, env);
|
||||
return init(ctx sexp_api_pass(NULL, 1), env);
|
||||
}
|
||||
#endif
|
||||
#endif
|
||||
|
||||
sexp sexp_load (sexp ctx, sexp source, sexp env) {
|
||||
sexp sexp_load_op (sexp ctx sexp_api_params(self, n), sexp source, sexp env) {
|
||||
#if SEXP_USE_DL
|
||||
char *suffix;
|
||||
#endif
|
||||
|
|
@ -2208,7 +2208,7 @@ static sexp sexp_sqrt (sexp ctx, sexp z) {
|
|||
|
||||
#endif
|
||||
|
||||
static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
|
||||
static sexp sexp_expt_op (sexp ctx sexp_api_params(self, n), sexp x, sexp e) {
|
||||
long double f, x1, e1;
|
||||
sexp res;
|
||||
#if SEXP_USE_BIGNUMS
|
||||
|
|
@ -2265,7 +2265,7 @@ static sexp sexp_expt (sexp ctx, sexp x, sexp e) {
|
|||
return res;
|
||||
}
|
||||
|
||||
static sexp sexp_string_cmp (sexp ctx, sexp str1, sexp str2, sexp ci) {
|
||||
static sexp sexp_string_cmp_op (sexp ctx sexp_api_params(self, n), sexp str1, sexp str2, sexp ci) {
|
||||
sexp_sint_t len1, len2, len, diff;
|
||||
if (! sexp_stringp(str1))
|
||||
return sexp_type_exception(ctx, "not a string", str1);
|
||||
|
|
@ -2293,7 +2293,7 @@ sexp sexp_apply_optimization (sexp ctx, sexp proc, sexp ast) {
|
|||
sexp res;
|
||||
sexp_gc_var1(args);
|
||||
if (sexp_opcodep(proc)) {
|
||||
res = ((sexp_proc2)sexp_opcode_func(proc))(ctx, ast);
|
||||
res = ((sexp_proc2)sexp_opcode_func(proc))(ctx sexp_api_pass(proc, 1), ast);
|
||||
} else {
|
||||
sexp_gc_preserve1(ctx, args);
|
||||
res = sexp_apply(ctx, proc, args=sexp_list1(ctx, ast));
|
||||
|
|
@ -2403,7 +2403,7 @@ sexp sexp_define_foreign_param (sexp ctx, sexp env, const char *name, int num_ar
|
|||
|
||||
#if SEXP_USE_TYPE_DEFS
|
||||
|
||||
sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type) {
|
||||
sexp sexp_make_type_predicate_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type) {
|
||||
if (! sexp_fixnump(type))
|
||||
return sexp_type_exception(ctx, "make-type-predicate: bad type", type);
|
||||
return sexp_make_opcode(ctx, name, sexp_make_fixnum(SEXP_OPC_TYPE_PREDICATE),
|
||||
|
|
@ -2411,7 +2411,7 @@ sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type) {
|
|||
SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, type, NULL, NULL);
|
||||
}
|
||||
|
||||
sexp sexp_make_constructor (sexp ctx, sexp name, sexp type) {
|
||||
sexp sexp_make_constructor_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type) {
|
||||
sexp_uint_t type_size;
|
||||
if (! sexp_fixnump(type))
|
||||
return sexp_type_exception(ctx, "make-constructor: bad type", type);
|
||||
|
|
@ -2422,7 +2422,7 @@ sexp sexp_make_constructor (sexp ctx, sexp name, sexp type) {
|
|||
sexp_make_fixnum(type_size), NULL);
|
||||
}
|
||||
|
||||
sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index) {
|
||||
sexp sexp_make_getter_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type, sexp index) {
|
||||
if ((! sexp_fixnump(type)) || (sexp_unbox_fixnum(type) < 0))
|
||||
return sexp_type_exception(ctx, "make-getter: bad type", type);
|
||||
if ((! sexp_fixnump(index)) || (sexp_unbox_fixnum(index) < 0))
|
||||
|
|
@ -2433,7 +2433,7 @@ sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index) {
|
|||
type, SEXP_ZERO, SEXP_ZERO, type, index, NULL);
|
||||
}
|
||||
|
||||
sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index) {
|
||||
sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type, sexp index) {
|
||||
if ((! sexp_fixnump(type)) || (sexp_unbox_fixnum(type) < 0))
|
||||
return sexp_type_exception(ctx, "make-setter: bad type", type);
|
||||
if ((! sexp_fixnump(index)) || (sexp_unbox_fixnum(index) < 0))
|
||||
|
|
@ -2465,7 +2465,7 @@ static struct sexp_struct core_forms[] = {
|
|||
{.tag=SEXP_CORE, .value={.core={SEXP_CORE_LETREC_SYNTAX, "letrec-syntax"}}},
|
||||
};
|
||||
|
||||
sexp sexp_make_env (sexp ctx) {
|
||||
sexp sexp_make_env_op (sexp ctx sexp_api_params(self, n)) {
|
||||
sexp e = sexp_alloc_type(ctx, env, SEXP_ENV);
|
||||
sexp_env_lambda(e) = NULL;
|
||||
sexp_env_parent(e) = NULL;
|
||||
|
|
@ -2473,7 +2473,7 @@ sexp sexp_make_env (sexp ctx) {
|
|||
return e;
|
||||
}
|
||||
|
||||
sexp sexp_make_null_env (sexp ctx, sexp version) {
|
||||
sexp sexp_make_null_env_op (sexp ctx sexp_api_params(self, n), sexp version) {
|
||||
sexp_uint_t i;
|
||||
sexp e = sexp_make_env(ctx);
|
||||
for (i=0; i<(sizeof(core_forms)/sizeof(core_forms[0])); i++)
|
||||
|
|
@ -2551,13 +2551,13 @@ sexp sexp_load_module_file (sexp ctx, const char *file, sexp env) {
|
|||
}
|
||||
|
||||
#if SEXP_USE_MODULES
|
||||
static sexp sexp_find_module_file_op (sexp ctx, sexp file) {
|
||||
static sexp sexp_find_module_file_op (sexp ctx sexp_api_params(self, n), sexp file) {
|
||||
if (! sexp_stringp(file))
|
||||
return sexp_type_exception(ctx, "not a string", file);
|
||||
else
|
||||
return sexp_find_module_file(ctx, sexp_string_data(file));
|
||||
}
|
||||
sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) {
|
||||
sexp sexp_load_module_file_op (sexp ctx sexp_api_params(self, n), sexp file, sexp env) {
|
||||
if (! sexp_stringp(file))
|
||||
return sexp_type_exception(ctx, "not a string", file);
|
||||
else if (! sexp_envp(env))
|
||||
|
|
@ -2566,7 +2566,7 @@ sexp sexp_load_module_file_op (sexp ctx, sexp file, sexp env) {
|
|||
}
|
||||
#endif
|
||||
|
||||
sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp) {
|
||||
sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp) {
|
||||
sexp ls;
|
||||
if (! sexp_stringp(dir))
|
||||
return sexp_type_exception(ctx, "not a string", dir);
|
||||
|
|
@ -2653,7 +2653,7 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
|
|||
return sexp_exceptionp(tmp) ? tmp : e;
|
||||
}
|
||||
|
||||
sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||
sexp sexp_make_standard_env_op (sexp ctx sexp_api_params(self, n), sexp version) {
|
||||
sexp_gc_var1(env);
|
||||
sexp_gc_preserve1(ctx, env);
|
||||
env = sexp_make_primitive_env(ctx, version);
|
||||
|
|
@ -2662,7 +2662,7 @@ sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
return env;
|
||||
}
|
||||
|
||||
sexp sexp_env_copy (sexp ctx, sexp to, sexp from, sexp ls, sexp immutp) {
|
||||
sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp) {
|
||||
sexp oldname, newname, value, out;
|
||||
if (! sexp_envp(to)) to = sexp_context_env(ctx);
|
||||
if (! sexp_envp(from)) from = sexp_context_env(ctx);
|
||||
|
|
@ -2746,7 +2746,7 @@ sexp sexp_compile (sexp ctx, sexp x) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_eval (sexp ctx, sexp obj, sexp env) {
|
||||
sexp sexp_eval_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp env) {
|
||||
sexp_sint_t top;
|
||||
sexp ctx2;
|
||||
sexp_gc_var2(res, err_handler);
|
||||
|
|
|
|||
4
gc.c
4
gc.c
|
|
@ -1,5 +1,5 @@
|
|||
/* gc.c -- simple mark&sweep garbage collector */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "chibi/sexp.h"
|
||||
|
|
@ -98,7 +98,7 @@ sexp sexp_sweep (sexp ctx, size_t *sum_freed_ptr) {
|
|||
if ((! sexp_gc_mark(p)) && (! stack_references_pointer_p(ctx, p))) {
|
||||
/* free p */
|
||||
finalizer = sexp_type_finalize(sexp_object_type(ctx, p));
|
||||
if (finalizer) finalizer(ctx, p);
|
||||
if (finalizer) finalizer(ctx sexp_api_pass(NULL, 1), p);
|
||||
sum_freed += size;
|
||||
if (((((char*)q) + q->size) == (char*)p) && (q != h->free_list)) {
|
||||
/* merge q with p */
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* eval.h -- headers for eval library */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#ifndef SEXP_EVAL_H
|
||||
|
|
@ -132,20 +132,20 @@ SEXP_API sexp sexp_apply (sexp context, sexp proc, sexp args);
|
|||
SEXP_API sexp sexp_apply_optimization (sexp context, sexp proc, sexp ast);
|
||||
SEXP_API sexp sexp_free_vars (sexp context, sexp x, sexp fv);
|
||||
SEXP_API int sexp_param_index (sexp lambda, sexp name);
|
||||
SEXP_API sexp sexp_eval (sexp context, sexp obj, sexp env);
|
||||
SEXP_API sexp sexp_eval_op (sexp context sexp_api_params(self, n), sexp obj, sexp env);
|
||||
SEXP_API sexp sexp_eval_string (sexp context, const char *str, sexp_sint_t len, sexp env);
|
||||
SEXP_API sexp sexp_load (sexp context, sexp expr, sexp env);
|
||||
SEXP_API sexp sexp_make_env (sexp context);
|
||||
SEXP_API sexp sexp_make_null_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_load_op (sexp context sexp_api_params(self, n), sexp expr, sexp env);
|
||||
SEXP_API sexp sexp_make_env_op (sexp context sexp_api_params(self, n));
|
||||
SEXP_API sexp sexp_make_null_env_op (sexp context sexp_api_params(self, n), sexp version);
|
||||
SEXP_API sexp sexp_make_primitive_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_make_standard_env (sexp context, sexp version);
|
||||
SEXP_API sexp sexp_make_standard_env_op (sexp context sexp_api_params(self, n), sexp version);
|
||||
SEXP_API sexp sexp_load_standard_parameters (sexp context, sexp env);
|
||||
SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version);
|
||||
SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
|
||||
SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
|
||||
SEXP_API sexp sexp_add_module_directory (sexp ctx, sexp dir, sexp appendp);
|
||||
SEXP_API sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp);
|
||||
SEXP_API sexp sexp_extend_env (sexp context, sexp env, sexp vars, sexp value);
|
||||
SEXP_API sexp sexp_env_copy (sexp context, sexp to, sexp from, sexp ls, sexp immutp);
|
||||
SEXP_API sexp sexp_env_copy_op (sexp context sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
|
||||
SEXP_API sexp sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
|
||||
SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
|
||||
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
|
||||
|
|
@ -162,12 +162,28 @@ SEXP_API sexp sexp_define_foreign_aux (sexp ctx, sexp env, const char *name, int
|
|||
SEXP_API sexp sexp_define_foreign_param (sexp ctx, sexp env, const char *name, int num_args, sexp_proc1 f, const char *param);
|
||||
|
||||
#if SEXP_USE_TYPE_DEFS
|
||||
SEXP_API sexp sexp_make_type_predicate (sexp ctx, sexp name, sexp type);
|
||||
SEXP_API sexp sexp_make_constructor (sexp ctx, sexp name, sexp type);
|
||||
SEXP_API sexp sexp_make_getter (sexp ctx, sexp name, sexp type, sexp index);
|
||||
SEXP_API sexp sexp_make_setter (sexp ctx, sexp name, sexp type, sexp index);
|
||||
SEXP_API sexp sexp_make_type_predicate_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type);
|
||||
SEXP_API sexp sexp_make_constructor_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type);
|
||||
SEXP_API sexp sexp_make_getter_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type, sexp index);
|
||||
SEXP_API sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name, sexp type, sexp index);
|
||||
#endif
|
||||
|
||||
/* simplify primitive API interface */
|
||||
#define sexp_make_synclo(ctx, a, b, c) sexp_make_synclo_op(ctx sexp_api_pass(NULL, 3) a, b, c)
|
||||
#define sexp_make_env(ctx) sexp_make_env_op(ctx sexp_api_pass(NULL, 0))
|
||||
#define sexp_make_null_env(ctx, v) sexp_make_null_env_op(ctx sexp_api_pass(NULL, 0), v)
|
||||
#define sexp_make_standard_env(ctx) sexp_make_standard_env_op(ctx sexp_api_pass(NULL, 0))
|
||||
#define sexp_add_module_directory(ctx, d, a) sexp_add_module_directory_op(ctx sexp_api_pass(NULL, 1), d, a)
|
||||
#define sexp_eval(ctx, x, e) sexp_eval_op(ctx sexp_api_pass(NULL, 2), x, e)
|
||||
#define sexp_load(ctx, f, e) sexp_load_op(ctx sexp_api_pass(NULL, 2), f, e)
|
||||
#define sexp_env_copy(ctx, a, b, c, d) sexp_env_copy_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
|
||||
#define sexp_identifierp(ctx, x) sexp_identifier_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
|
||||
#define sexp_open_input_file(ctx, x) sexp_open_input_file_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_open_output_file(ctx, x) sexp_open_output_file_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_close_port(ctx, x) sexp_close_port_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
|
||||
#ifdef __cplusplus
|
||||
} /* extern "C" */
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* features.h -- general feature configuration */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
/* uncomment this to disable most features */
|
||||
|
|
@ -104,6 +104,10 @@
|
|||
/* Automatically disabled if you've disabled flonums. */
|
||||
/* #define SEXP_USE_MATH 0 */
|
||||
|
||||
/* uncomment this to disable the self and n parameters to primitives */
|
||||
/* This is the old style API. */
|
||||
/* #define SEXP_USE_SELF_PARAMETER 0 */
|
||||
|
||||
/* uncomment this to disable warning about references to undefined variables */
|
||||
/* This is something of a hack, but can be quite useful. */
|
||||
/* It's very fast and doesn't involve any separate analysis */
|
||||
|
|
@ -288,6 +292,10 @@
|
|||
#define SEXP_USE_MATH SEXP_USE_FLONUMS && ! SEXP_USE_NO_FEATURES
|
||||
#endif
|
||||
|
||||
#ifndef SEXP_USE_SELF_PARAMETER
|
||||
#define SEXP_USE_SELF_PARAMETER 1
|
||||
#endif
|
||||
|
||||
#ifndef SEXP_USE_WARN_UNDEFS
|
||||
#define SEXP_USE_WARN_UNDEFS ! SEXP_USE_NO_FEATURES
|
||||
#endif
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
/* sexp.h -- header for sexp library */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#ifndef SEXP_H
|
||||
|
|
@ -125,15 +125,23 @@ typedef struct sexp_struct *sexp;
|
|||
#define SEXP_MAX_FIXNUM ((((sexp_sint_t)1)<<(sizeof(sexp_sint_t)*8-SEXP_FIXNUM_BITS-1))-1)
|
||||
#define SEXP_MIN_FIXNUM (-SEXP_MAX_FIXNUM-1)
|
||||
|
||||
#if SEXP_USE_SELF_PARAMETER
|
||||
#define sexp_api_params(self, n) , sexp self, long n
|
||||
#define sexp_api_pass(self, n) , self, n
|
||||
#else
|
||||
#define sexp_api_params(self, n)
|
||||
#define sexp_api_pass(self, n)
|
||||
#endif
|
||||
|
||||
/* procedure types */
|
||||
typedef sexp (*sexp_proc0) (void);
|
||||
typedef sexp (*sexp_proc1) (sexp);
|
||||
typedef sexp (*sexp_proc2) (sexp, sexp);
|
||||
typedef sexp (*sexp_proc3) (sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc4) (sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc5) (sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc6) (sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc7) (sexp, sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc1) (sexp sexp_api_params(self, n));
|
||||
typedef sexp (*sexp_proc2) (sexp sexp_api_params(self, n), sexp);
|
||||
typedef sexp (*sexp_proc3) (sexp sexp_api_params(self, n), sexp, sexp);
|
||||
typedef sexp (*sexp_proc4) (sexp sexp_api_params(self, n), sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc5) (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc6) (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp);
|
||||
typedef sexp (*sexp_proc7) (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp);
|
||||
|
||||
typedef struct sexp_free_list_t *sexp_free_list;
|
||||
struct sexp_free_list_t {
|
||||
|
|
@ -820,46 +828,46 @@ SEXP_API sexp sexp_buffered_flush (sexp ctx, sexp p);
|
|||
|
||||
SEXP_API sexp sexp_make_context(sexp ctx, sexp_uint_t size);
|
||||
SEXP_API sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
|
||||
SEXP_API sexp sexp_cons(sexp ctx, sexp head, sexp tail);
|
||||
SEXP_API sexp sexp_cons_op(sexp ctx sexp_api_params(self, n), sexp head, sexp tail);
|
||||
SEXP_API sexp sexp_list2(sexp ctx, sexp a, sexp b);
|
||||
SEXP_API sexp sexp_equalp (sexp ctx, sexp a, sexp b);
|
||||
SEXP_API sexp sexp_listp(sexp ctx, sexp obj);
|
||||
SEXP_API sexp sexp_reverse(sexp ctx, sexp ls);
|
||||
SEXP_API sexp sexp_nreverse(sexp ctx, sexp ls);
|
||||
SEXP_API sexp sexp_append2(sexp ctx, sexp a, sexp b);
|
||||
SEXP_API sexp sexp_memq(sexp ctx, sexp x, sexp ls);
|
||||
SEXP_API sexp sexp_assq(sexp ctx, sexp x, sexp ls);
|
||||
SEXP_API sexp sexp_length(sexp ctx, sexp ls);
|
||||
SEXP_API sexp sexp_equalp_op (sexp ctx sexp_api_params(self, n), sexp a, sexp b);
|
||||
SEXP_API sexp sexp_listp_op(sexp ctx sexp_api_params(self, n), sexp obj);
|
||||
SEXP_API sexp sexp_reverse_op(sexp ctx sexp_api_params(self, n), sexp ls);
|
||||
SEXP_API sexp sexp_nreverse_op(sexp ctx sexp_api_params(self, n), sexp ls);
|
||||
SEXP_API sexp sexp_append2_op(sexp ctx sexp_api_params(self, n), sexp a, sexp b);
|
||||
SEXP_API sexp sexp_memq_op(sexp ctx sexp_api_params(self, n), sexp x, sexp ls);
|
||||
SEXP_API sexp sexp_assq_op(sexp ctx sexp_api_params(self, n), sexp x, sexp ls);
|
||||
SEXP_API sexp sexp_length_op(sexp ctx sexp_api_params(self, n), sexp ls);
|
||||
SEXP_API sexp sexp_c_string(sexp ctx, const char *str, sexp_sint_t slen);
|
||||
SEXP_API sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
|
||||
SEXP_API sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
|
||||
SEXP_API sexp sexp_string_concatenate (sexp ctx, sexp str_ls, sexp sep);
|
||||
SEXP_API sexp sexp_make_string_op(sexp ctx sexp_api_params(self, n), sexp len, sexp ch);
|
||||
SEXP_API sexp sexp_substring_op (sexp ctx sexp_api_params(self, n), sexp str, sexp start, sexp end);
|
||||
SEXP_API sexp sexp_string_concatenate_op (sexp ctx sexp_api_params(self, n), sexp str_ls, sexp sep);
|
||||
SEXP_API sexp sexp_intern (sexp ctx, const char *str, sexp_sint_t len);
|
||||
SEXP_API sexp sexp_string_to_symbol(sexp ctx, sexp str);
|
||||
SEXP_API sexp sexp_string_to_symbol_op (sexp ctx sexp_api_params(self, n), sexp str);
|
||||
SEXP_API sexp sexp_make_vector (sexp ctx, sexp len, sexp dflt);
|
||||
SEXP_API sexp sexp_list_to_vector(sexp ctx, sexp ls);
|
||||
SEXP_API sexp sexp_list_to_vector_op (sexp ctx sexp_api_params(self, n), sexp ls);
|
||||
SEXP_API sexp sexp_make_cpointer (sexp ctx, sexp_uint_t type_id, void* value, sexp parent, int freep);
|
||||
SEXP_API sexp sexp_write(sexp ctx, sexp obj, sexp out);
|
||||
SEXP_API sexp sexp_display(sexp ctx, sexp obj, sexp out);
|
||||
SEXP_API sexp sexp_flush_output(sexp ctx, sexp out);
|
||||
SEXP_API sexp sexp_write_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp out);
|
||||
SEXP_API sexp sexp_display_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp out);
|
||||
SEXP_API sexp sexp_flush_output_op (sexp ctx sexp_api_params(self, n), sexp out);
|
||||
SEXP_API sexp sexp_read_string (sexp ctx, sexp in);
|
||||
SEXP_API sexp sexp_read_symbol (sexp ctx, sexp in, int init, int internp);
|
||||
SEXP_API sexp sexp_read_number (sexp ctx, sexp in, int base);
|
||||
SEXP_API sexp sexp_read_raw (sexp ctx, sexp in);
|
||||
SEXP_API sexp sexp_read(sexp ctx, sexp in);
|
||||
SEXP_API sexp sexp_read_op (sexp ctx sexp_api_params(self, n), sexp in);
|
||||
SEXP_API sexp sexp_read_from_string (sexp ctx, const char *str, sexp_sint_t len);
|
||||
SEXP_API sexp sexp_write_to_string (sexp ctx, sexp obj);
|
||||
SEXP_API sexp sexp_finalize_port (sexp ctx, sexp port);
|
||||
SEXP_API sexp sexp_finalize_port (sexp ctx sexp_api_params(self, n), sexp port);
|
||||
SEXP_API sexp sexp_make_input_port (sexp ctx, FILE* in, sexp name);
|
||||
SEXP_API sexp sexp_make_output_port (sexp ctx, FILE* out, sexp name);
|
||||
SEXP_API sexp sexp_make_input_string_port(sexp ctx, sexp str);
|
||||
SEXP_API sexp sexp_make_output_string_port(sexp ctx);
|
||||
SEXP_API sexp sexp_get_output_string(sexp ctx, sexp port);
|
||||
SEXP_API sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str);
|
||||
SEXP_API sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n));
|
||||
SEXP_API sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port);
|
||||
SEXP_API sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp source);
|
||||
SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, const char *msg, sexp x);
|
||||
SEXP_API sexp sexp_type_exception (sexp ctx, const char *message, sexp x);
|
||||
SEXP_API sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
|
||||
SEXP_API sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
|
||||
SEXP_API sexp sexp_print_exception_op (sexp ctx sexp_api_params(self, n), sexp exn, sexp out);
|
||||
SEXP_API void sexp_init(void);
|
||||
|
||||
#define SEXP_COPY_DEFAULT SEXP_ZERO
|
||||
|
|
@ -873,10 +881,10 @@ SEXP_API sexp sexp_copy_context(sexp ctx, sexp dst, sexp flags);
|
|||
#endif
|
||||
|
||||
#if SEXP_USE_TYPE_DEFS
|
||||
SEXP_API sexp sexp_register_type (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
|
||||
SEXP_API sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots);
|
||||
SEXP_API sexp sexp_register_type_op (sexp sexp_api_params(self, n), sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc2);
|
||||
SEXP_API sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp slots);
|
||||
SEXP_API sexp sexp_register_c_type (sexp ctx, sexp name);
|
||||
SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp obj);
|
||||
SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj);
|
||||
#define sexp_register_c_type(ctx, name, finalizer) \
|
||||
sexp_register_type(ctx, name, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, SEXP_ZERO, \
|
||||
SEXP_ZERO, sexp_make_fixnum(sexp_sizeof(cpointer)), \
|
||||
|
|
@ -886,6 +894,38 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx, sexp obj);
|
|||
#define sexp_current_error_port(ctx) sexp_env_global_ref(sexp_context_env(ctx),sexp_global(ctx,SEXP_G_CUR_ERR_SYMBOL),SEXP_FALSE)
|
||||
#define sexp_debug(ctx, msg, obj) (sexp_write_string(ctx, msg, sexp_current_error_port(ctx)), sexp_write(ctx, obj, sexp_current_error_port(ctx)), sexp_write_char(ctx, '\n', sexp_current_error_port(ctx)))
|
||||
|
||||
/* simplify primitive API interface */
|
||||
|
||||
#define sexp_read(ctx, in) sexp_read_op(ctx sexp_api_pass(NULL, 1), in)
|
||||
#define sexp_write(ctx, obj, out) sexp_write_op(ctx sexp_api_pass(NULL, 2), obj, out)
|
||||
#define sexp_display(ctx, obj, out) sexp_display_op(ctx sexp_api_pass(NULL, 2), obj, out)
|
||||
#define sexp_print_exception(ctx, e, out) sexp_print_exception_op(ctx sexp_api_pass(NULL, 2), e, out)
|
||||
#define sexp_flush_output(ctx, obj, out) sexp_flush_output_op(ctx sexp_api_pass(NULL, 1), out)
|
||||
#define sexp_equalp(ctx, a, b) sexp_equalp_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_listp(ctx, x) sexp_listp_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_length(ctx, x) sexp_length_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_reverse(ctx, x) sexp_reverse_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_nreverse(ctx, x) sexp_nreverse_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_cons(ctx, a, b) sexp_cons_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_append2(ctx, a, b) sexp_append2_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_list_to_vector(ctx, x) sexp_list_to_vector_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_exception_type(ctx, x) sexp_exception_type_op(ctx sexp_api_pass(NULL, 1), x)
|
||||
#define sexp_make_string(ctx, l, c) sexp_make_string_op(ctx sexp_api_pass(NULL, 2), l, c)
|
||||
#define sexp_string_cmp(ctx, a, b, c) sexp_string_cmp_op(ctx sexp_api_pass(NULL, 3), a, b, c)
|
||||
#define sexp_substring(ctx, a, b, c) sexp_substring_op(ctx sexp_api_pass(NULL, 3), a, b, c)
|
||||
#define sexp_string_concatenate(ctx, ls, s) sexp_string_concatenate_op(ctx sexp_api_pass(NULL, 2), ls, s)
|
||||
#define sexp_memq(ctx, a, b) sexp_memq_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_assq(ctx, a, b) sexp_assq_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_make_output_string_port(ctx) sexp_make_output_string_port_op(ctx sexp_api_pass(NULL, 0))
|
||||
#define sexp_make_input_string_port(ctx, s) sexp_make_input_string_port_op(ctx sexp_api_pass(NULL, 1), s)
|
||||
#define sexp_get_output_string(ctx, out) sexp_get_output_string_op(ctx sexp_api_pass(NULL, 1), out)
|
||||
#define sexp_expt(ctx, a, b) sexp_expt_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_register_simple_type(ctx, a, b) sexp_register_simple_type_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx sexp_api_pass(NULL, 2), a, b)
|
||||
#define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
|
||||
#define sexp_make_setter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
|
||||
|
||||
#ifdef __cplusplus
|
||||
} /* extern "C" */
|
||||
#endif
|
||||
|
|
|
|||
92
opcodes.c
92
opcodes.c
|
|
@ -58,7 +58,7 @@ _OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "pair?", sexp_make_f
|
|||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "string?", sexp_make_fixnum(SEXP_STRING), 0),
|
||||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "vector?", sexp_make_fixnum(SEXP_VECTOR), 0),
|
||||
#if SEXP_USE_IMMEDIATE_FLONUMS
|
||||
_FN1(0, "flonum?", 0, sexp_flonum_predicate),
|
||||
_FN1(0, "flonum?", 0, sexp_flonump_op),
|
||||
#else
|
||||
_OP(SEXP_OPC_TYPE_PREDICATE, SEXP_OP_TYPEP, 1, 0, 0, 0, 0, "flonum?", sexp_make_fixnum(SEXP_FLONUM), 0),
|
||||
#endif
|
||||
|
|
@ -74,49 +74,49 @@ _OP(SEXP_OPC_IO, SEXP_OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp
|
|||
_OP(SEXP_OPC_IO, SEXP_OP_NEWLINE, 0, 3, 0, SEXP_OPORT, 0, "newline", (sexp)"*current-output-port*", NULL),
|
||||
_OP(SEXP_OPC_IO, SEXP_OP_READ_CHAR, 0, 3, 0, SEXP_IPORT, 0, "read-char", (sexp)"*current-input-port*", NULL),
|
||||
_OP(SEXP_OPC_IO, SEXP_OP_PEEK_CHAR, 0, 3, 0, SEXP_IPORT, 0, "peek-char", (sexp)"*current-input-port*", NULL),
|
||||
_FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read),
|
||||
_FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write),
|
||||
_FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display),
|
||||
_FN1OPTP(SEXP_OPORT, "flush-output", (sexp)"*current-output-port*", sexp_flush_output),
|
||||
_FN2(0, 0, "equal?", 0, sexp_equalp),
|
||||
_FN1(0, "list?", 0, sexp_listp),
|
||||
_FN1(0, "identifier?", 0, sexp_identifierp),
|
||||
_FN1(0, "identifier->symbol", 0, sexp_syntactic_closure_expr),
|
||||
_FN4(0, SEXP_ENV, "identifier=?", 0, sexp_identifier_eq),
|
||||
_FN1(SEXP_PAIR, "length", 0, sexp_length),
|
||||
_FN1(SEXP_PAIR, "reverse", 0, sexp_reverse),
|
||||
_FN1(SEXP_PAIR, "reverse!", 0, sexp_nreverse),
|
||||
_FN2(SEXP_PAIR, SEXP_PAIR, "append2", 0, sexp_append2),
|
||||
_FN1(SEXP_PAIR, "list->vector", 0, sexp_list_to_vector),
|
||||
_FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file),
|
||||
_FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file),
|
||||
_FN1(SEXP_IPORT, "close-input-port", 0, sexp_close_port),
|
||||
_FN1(SEXP_OPORT, "close-output-port", 0, sexp_close_port),
|
||||
_FN0("make-environment", 0, sexp_make_env),
|
||||
_FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env),
|
||||
_FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env),
|
||||
_FN2OPTP(0, SEXP_ENV, "eval", (sexp)"*interaction-environment*", sexp_eval),
|
||||
_FN2OPTP(SEXP_STRING, SEXP_ENV, "load", (sexp)"*interaction-environment*", sexp_load),
|
||||
_FN4(SEXP_ENV, SEXP_ENV, "%env-copy!", 0, sexp_env_copy),
|
||||
_FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception),
|
||||
_FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func),
|
||||
_FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string),
|
||||
_FN3(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring),
|
||||
_FN1(SEXP_STRING, "string->symbol", 0, sexp_string_to_symbol),
|
||||
_FN2OPT(SEXP_PAIR, SEXP_STRING, "string-concatenate", SEXP_FALSE, sexp_string_concatenate),
|
||||
_FN2(0, SEXP_PAIR, "memq", 0, sexp_memq),
|
||||
_FN2(0, SEXP_PAIR, "assq", 0, sexp_assq),
|
||||
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", 0, sexp_make_synclo),
|
||||
_FN1OPTP(SEXP_IPORT, "read", (sexp)"*current-input-port*", sexp_read_op),
|
||||
_FN2OPTP(0, SEXP_OPORT, "write", (sexp)"*current-output-port*", sexp_write_op),
|
||||
_FN2OPTP(0, SEXP_OPORT, "display", (sexp)"*current-output-port*", sexp_display_op),
|
||||
_FN1OPTP(SEXP_OPORT, "flush-output", (sexp)"*current-output-port*", sexp_flush_output_op),
|
||||
_FN2(0, 0, "equal?", 0, sexp_equalp_op),
|
||||
_FN1(0, "list?", 0, sexp_listp_op),
|
||||
_FN1(0, "identifier?", 0, sexp_identifierp_op),
|
||||
_FN1(0, "identifier->symbol", 0, sexp_syntactic_closure_expr_op),
|
||||
_FN4(0, SEXP_ENV, "identifier=?", 0, sexp_identifier_eq_op),
|
||||
_FN1(SEXP_PAIR, "length", 0, sexp_length_op),
|
||||
_FN1(SEXP_PAIR, "reverse", 0, sexp_reverse_op),
|
||||
_FN1(SEXP_PAIR, "reverse!", 0, sexp_nreverse_op),
|
||||
_FN2(SEXP_PAIR, SEXP_PAIR, "append2", 0, sexp_append2_op),
|
||||
_FN1(SEXP_PAIR, "list->vector", 0, sexp_list_to_vector_op),
|
||||
_FN1(SEXP_STRING, "open-input-file", 0, sexp_open_input_file_op),
|
||||
_FN1(SEXP_STRING, "open-output-file", 0, sexp_open_output_file_op),
|
||||
_FN1(SEXP_IPORT, "close-input-port", 0, sexp_close_port_op),
|
||||
_FN1(SEXP_OPORT, "close-output-port", 0, sexp_close_port_op),
|
||||
_FN0("make-environment", 0, sexp_make_env_op),
|
||||
_FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env_op),
|
||||
_FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env_op),
|
||||
_FN2OPTP(0, SEXP_ENV, "eval", (sexp)"*interaction-environment*", sexp_eval_op),
|
||||
_FN2OPTP(SEXP_STRING, SEXP_ENV, "load", (sexp)"*interaction-environment*", sexp_load_op),
|
||||
_FN4(SEXP_ENV, SEXP_ENV, "%env-copy!", 0, sexp_env_copy_op),
|
||||
_FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception_op),
|
||||
_FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_op),
|
||||
_FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string_op),
|
||||
_FN3(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp_op),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "substring", 0, sexp_substring_op),
|
||||
_FN1(SEXP_STRING, "string->symbol", 0, sexp_string_to_symbol_op),
|
||||
_FN2OPT(SEXP_PAIR, SEXP_STRING, "string-concatenate", SEXP_FALSE, sexp_string_concatenate_op),
|
||||
_FN2(0, SEXP_PAIR, "memq", 0, sexp_memq_op),
|
||||
_FN2(0, SEXP_PAIR, "assq", 0, sexp_assq_op),
|
||||
_FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", 0, sexp_make_synclo_op),
|
||||
_FN1(0, "strip-syntactic-closures", 0, sexp_strip_synclos),
|
||||
_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-exception-handler", (sexp)"*current-exception-handler*", SEXP_PROCEDURE),
|
||||
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
|
||||
_FN0("open-output-string", 0, sexp_make_output_string_port),
|
||||
_FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port),
|
||||
_FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string),
|
||||
_FN0("open-output-string", 0, sexp_make_output_string_port_op),
|
||||
_FN1(SEXP_STRING, "open-input-string", 0, sexp_make_input_string_port_op),
|
||||
_FN1(SEXP_OPORT, "get-output-string", 0, sexp_get_output_string_op),
|
||||
#if SEXP_USE_MATH
|
||||
_FN1(0, "exp", 0, sexp_exp),
|
||||
_FN1(0, "log", 0, sexp_log),
|
||||
|
|
@ -132,22 +132,22 @@ _FN1(0, "truncate", 0, sexp_trunc),
|
|||
_FN1(0, "floor", 0, sexp_floor),
|
||||
_FN1(0, "ceiling", 0, sexp_ceiling),
|
||||
#endif
|
||||
_FN2(0, 0, "expt", 0, sexp_expt),
|
||||
_FN2(0, 0, "expt", 0, sexp_expt_op),
|
||||
#if SEXP_USE_TYPE_DEFS
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type),
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate),
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter),
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "register-simple-type", 0, sexp_register_simple_type_op),
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-type-predicate", 0, sexp_make_type_predicate_op),
|
||||
_FN2(SEXP_STRING, SEXP_FIXNUM, "make-constructor", 0, sexp_make_constructor_op),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-getter", 0, sexp_make_getter_op),
|
||||
_FN3(SEXP_STRING, SEXP_FIXNUM, "make-setter", 0, sexp_make_setter_op),
|
||||
#endif
|
||||
#if PLAN9
|
||||
#include "opt/plan9-opcodes.c"
|
||||
#endif
|
||||
#if SEXP_USE_MODULES
|
||||
_FN1(SEXP_ENV, "env-exports", 0, sexp_env_exports),
|
||||
_FN1(SEXP_ENV, "env-exports", 0, sexp_env_exports_op),
|
||||
_FN1(SEXP_STRING, "find-module-file", 0, sexp_find_module_file_op),
|
||||
_FN2(SEXP_STRING, SEXP_ENV, "load-module-file", 0, sexp_load_module_file_op),
|
||||
_FN2(SEXP_STRING, SEXP_BOOLEAN, "add-module-directory", 0, sexp_add_module_directory),
|
||||
_FN2(SEXP_STRING, SEXP_BOOLEAN, "add-module-directory", 0, sexp_add_module_directory_op),
|
||||
#endif
|
||||
};
|
||||
|
||||
|
|
|
|||
|
|
@ -137,7 +137,7 @@ static sexp simplify (sexp ctx, sexp ast, sexp init_substs, sexp lambda) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_simplify (sexp ctx, sexp ast) {
|
||||
sexp sexp_simplify (sexp ctx sexp_api_params(self, n), sexp ast) {
|
||||
return simplify(ctx, ast, SEXP_NULL, NULL);
|
||||
}
|
||||
|
||||
|
|
|
|||
71
sexp.c
71
sexp.c
|
|
@ -1,5 +1,5 @@
|
|||
/* sexp.c -- standalone sexp library implementation */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* Copyright (c) 2009-2010 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "chibi/sexp.h"
|
||||
|
|
@ -53,7 +53,7 @@ sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_finalize_port (sexp ctx, sexp port) {
|
||||
sexp sexp_finalize_port (sexp ctx sexp_api_params(self, n), sexp port) {
|
||||
if (sexp_port_openp(port)) {
|
||||
sexp_port_openp(port) = 0;
|
||||
if (sexp_port_stream(port) && ! sexp_port_no_closep(port))
|
||||
|
|
@ -184,7 +184,7 @@ sexp sexp_register_type (sexp ctx, sexp name, sexp fb, sexp felb, sexp flb,
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots) {
|
||||
sexp sexp_register_simple_type_op (sexp ctx sexp_api_params(self, n), sexp name, sexp slots) {
|
||||
short type_size = sexp_sizeof_header + sizeof(sexp)*sexp_unbox_fixnum(slots);
|
||||
return
|
||||
sexp_register_type(ctx, name, sexp_make_fixnum(sexp_offsetof_slot0),
|
||||
|
|
@ -192,7 +192,7 @@ sexp sexp_register_simple_type (sexp ctx, sexp name, sexp slots) {
|
|||
sexp_make_fixnum(type_size), SEXP_ZERO, SEXP_ZERO, NULL);
|
||||
}
|
||||
|
||||
sexp sexp_finalize_c_type (sexp ctx, sexp obj) {
|
||||
sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj) {
|
||||
if (sexp_cpointer_freep(obj))
|
||||
free(sexp_cpointer_value(obj));
|
||||
return SEXP_VOID;
|
||||
|
|
@ -365,7 +365,7 @@ sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
|
||||
sexp sexp_print_exception_op (sexp ctx sexp_api_params(self, n), sexp exn, sexp out) {
|
||||
sexp ls;
|
||||
if (! sexp_oportp(out))
|
||||
out = sexp_make_output_port(ctx, stderr, SEXP_FALSE);
|
||||
|
|
@ -440,7 +440,7 @@ static sexp sexp_read_error (sexp ctx, const char *msg, sexp ir, sexp port) {
|
|||
|
||||
/*************************** list utilities ***************************/
|
||||
|
||||
sexp sexp_cons (sexp ctx, sexp head, sexp tail) {
|
||||
sexp sexp_cons_op (sexp ctx sexp_api_params(self, n), sexp head, sexp tail) {
|
||||
sexp pair = sexp_alloc_type(ctx, pair, SEXP_PAIR);
|
||||
if (sexp_exceptionp(pair)) return pair;
|
||||
sexp_car(pair) = head;
|
||||
|
|
@ -458,7 +458,7 @@ sexp sexp_list2 (sexp ctx, sexp a, sexp b) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_listp (sexp ctx, sexp hare) {
|
||||
sexp sexp_listp_op (sexp ctx sexp_api_params(self, n), sexp hare) {
|
||||
sexp turtle;
|
||||
if (! sexp_pairp(hare))
|
||||
return sexp_make_boolean(sexp_nullp(hare));
|
||||
|
|
@ -472,7 +472,7 @@ sexp sexp_listp (sexp ctx, sexp hare) {
|
|||
return sexp_make_boolean(sexp_nullp(hare));
|
||||
}
|
||||
|
||||
sexp sexp_memq (sexp ctx, sexp x, sexp ls) {
|
||||
sexp sexp_memq_op (sexp ctx sexp_api_params(self, n), sexp x, sexp ls) {
|
||||
while (sexp_pairp(ls))
|
||||
if (x == sexp_car(ls))
|
||||
return ls;
|
||||
|
|
@ -481,7 +481,7 @@ sexp sexp_memq (sexp ctx, sexp x, sexp ls) {
|
|||
return SEXP_FALSE;
|
||||
}
|
||||
|
||||
sexp sexp_assq (sexp ctx, sexp x, sexp ls) {
|
||||
sexp sexp_assq_op (sexp ctx sexp_api_params(self, n), sexp x, sexp ls) {
|
||||
while (sexp_pairp(ls))
|
||||
if (sexp_pairp(sexp_car(ls)) && (x == sexp_caar(ls)))
|
||||
return sexp_car(ls);
|
||||
|
|
@ -490,7 +490,7 @@ sexp sexp_assq (sexp ctx, sexp x, sexp ls) {
|
|||
return SEXP_FALSE;
|
||||
}
|
||||
|
||||
sexp sexp_reverse (sexp ctx, sexp ls) {
|
||||
sexp sexp_reverse_op (sexp ctx sexp_api_params(self, n), sexp ls) {
|
||||
sexp_gc_var1(res);
|
||||
sexp_gc_preserve1(ctx, res);
|
||||
for (res=SEXP_NULL; sexp_pairp(ls); ls=sexp_cdr(ls))
|
||||
|
|
@ -499,7 +499,7 @@ sexp sexp_reverse (sexp ctx, sexp ls) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_nreverse (sexp ctx, sexp ls) {
|
||||
sexp sexp_nreverse_op (sexp ctx sexp_api_params(self, n), sexp ls) {
|
||||
sexp a, b, tmp;
|
||||
if (ls == SEXP_NULL) {
|
||||
return ls;
|
||||
|
|
@ -517,7 +517,7 @@ sexp sexp_nreverse (sexp ctx, sexp ls) {
|
|||
}
|
||||
}
|
||||
|
||||
sexp sexp_append2 (sexp ctx, sexp a, sexp b) {
|
||||
sexp sexp_append2_op (sexp ctx sexp_api_params(self, n), sexp a, sexp b) {
|
||||
sexp_gc_var2(a1, b1);
|
||||
sexp_gc_preserve2(ctx, a1, b1);
|
||||
b1 = b;
|
||||
|
|
@ -527,14 +527,14 @@ sexp sexp_append2 (sexp ctx, sexp a, sexp b) {
|
|||
return b1;
|
||||
}
|
||||
|
||||
sexp sexp_length (sexp ctx, sexp ls) {
|
||||
sexp sexp_length_op (sexp ctx sexp_api_params(self, n), sexp ls) {
|
||||
sexp_uint_t res=0;
|
||||
for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls))
|
||||
;
|
||||
return sexp_make_fixnum(res);
|
||||
}
|
||||
|
||||
sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
|
||||
sexp sexp_equalp_op (sexp ctx sexp_api_params(self, n), sexp a, sexp b) {
|
||||
sexp_uint_t size;
|
||||
sexp_sint_t i, len;
|
||||
sexp t, *p, *q;
|
||||
|
|
@ -597,7 +597,7 @@ sexp sexp_make_flonum (sexp ctx, double f) {
|
|||
return x;
|
||||
}
|
||||
#else
|
||||
sexp sexp_flonum_predicate (sexp ctx, sexp x) {
|
||||
sexp sexp_flonump_op (sexp ctx sexp_api_params(self, n), sexp x) {
|
||||
return sexp_make_boolean(sexp_flonump(x));
|
||||
}
|
||||
#if SEXP_64_BIT
|
||||
|
|
@ -614,7 +614,7 @@ sexp sexp_make_flonum (sexp ctx, float f) {
|
|||
#endif
|
||||
#endif
|
||||
|
||||
sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
|
||||
sexp sexp_make_string_op (sexp ctx sexp_api_params(self, n), sexp len, sexp ch) {
|
||||
sexp_sint_t clen = sexp_unbox_fixnum(len);
|
||||
sexp s;
|
||||
if (! sexp_fixnump(len)) return sexp_type_exception(ctx, "bad length", len);
|
||||
|
|
@ -637,7 +637,7 @@ sexp sexp_c_string(sexp ctx, const char *str, sexp_sint_t slen) {
|
|||
return s;
|
||||
}
|
||||
|
||||
sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
|
||||
sexp sexp_substring_op (sexp ctx sexp_api_params(self, n), sexp str, sexp start, sexp end) {
|
||||
sexp res;
|
||||
if (! sexp_stringp(str))
|
||||
return sexp_type_exception(ctx, "not a string", str);
|
||||
|
|
@ -661,7 +661,7 @@ sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_string_concatenate (sexp ctx, sexp str_ls, sexp sep) {
|
||||
sexp sexp_string_concatenate_op (sexp ctx sexp_api_params(self, n), sexp str_ls, sexp sep) {
|
||||
sexp res, ls;
|
||||
sexp_uint_t len=0, i=0, sep_len=0;
|
||||
char *p, *csep;
|
||||
|
|
@ -752,7 +752,7 @@ sexp sexp_intern(sexp ctx, const char *str, sexp_sint_t len) {
|
|||
return sym;
|
||||
}
|
||||
|
||||
sexp sexp_string_to_symbol (sexp ctx, sexp str) {
|
||||
sexp sexp_string_to_symbol_op (sexp ctx sexp_api_params(self, n), sexp str) {
|
||||
if (! sexp_stringp(str))
|
||||
return sexp_type_exception(ctx, "string->symbol: not a string", str);
|
||||
return sexp_intern(ctx, sexp_string_data(str), sexp_string_length(str));
|
||||
|
|
@ -772,7 +772,7 @@ sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
|
|||
return vec;
|
||||
}
|
||||
|
||||
sexp sexp_list_to_vector(sexp ctx, sexp ls) {
|
||||
sexp sexp_list_to_vector_op (sexp ctx sexp_api_params(self, n), sexp ls) {
|
||||
sexp x, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
|
||||
sexp *elts;
|
||||
int i;
|
||||
|
|
@ -857,7 +857,7 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
|
|||
return pos;
|
||||
}
|
||||
|
||||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str) {
|
||||
FILE *in;
|
||||
sexp res;
|
||||
sexp_gc_var1(cookie);
|
||||
|
|
@ -874,7 +874,7 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
|
||||
FILE *out;
|
||||
sexp res, size;
|
||||
sexp_gc_var1(cookie);
|
||||
|
|
@ -892,7 +892,7 @@ sexp sexp_make_output_string_port (sexp ctx) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_get_output_string (sexp ctx, sexp port) {
|
||||
sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port) {
|
||||
sexp cookie = sexp_port_cookie(port);
|
||||
fflush(sexp_port_stream(port));
|
||||
return sexp_substring(ctx,
|
||||
|
|
@ -903,7 +903,7 @@ sexp sexp_get_output_string (sexp ctx, sexp port) {
|
|||
|
||||
#else
|
||||
|
||||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str) {
|
||||
FILE *in;
|
||||
sexp res;
|
||||
if (! sexp_stringp(str))
|
||||
|
|
@ -923,14 +923,14 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
|
||||
sexp res = sexp_make_output_port(ctx, NULL, SEXP_FALSE);
|
||||
sexp_port_stream(res)
|
||||
= open_memstream(&sexp_port_buf(res), &sexp_port_size(res));
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_get_output_string (sexp ctx, sexp port) {
|
||||
sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp port) {
|
||||
fflush(sexp_port_stream(port));
|
||||
return sexp_c_string(ctx, sexp_port_buf(port), sexp_port_size(port));
|
||||
}
|
||||
|
|
@ -996,7 +996,7 @@ sexp sexp_buffered_flush (sexp ctx, sexp p) {
|
|||
}
|
||||
}
|
||||
|
||||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
sexp sexp_make_input_string_port_op (sexp ctx sexp_api_params(self, n), sexp str) {
|
||||
sexp res;
|
||||
if (! sexp_stringp(str))
|
||||
return sexp_type_exception(ctx, "open-input-string: not a string", str);
|
||||
|
|
@ -1009,7 +1009,7 @@ sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
sexp sexp_make_output_string_port_op (sexp ctx sexp_api_params(self, n)) {
|
||||
sexp res = sexp_make_output_port(ctx, NULL, SEXP_FALSE);
|
||||
if (sexp_exceptionp(res)) return res;
|
||||
sexp_port_buf(res) = (char*) malloc(SEXP_PORT_BUFFER_SIZE);
|
||||
|
|
@ -1019,7 +1019,7 @@ sexp sexp_make_output_string_port (sexp ctx) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_get_output_string (sexp ctx, sexp out) {
|
||||
sexp sexp_get_output_string_op (sexp ctx sexp_api_params(self, n), sexp out) {
|
||||
sexp res;
|
||||
sexp_gc_var2(ls, tmp);
|
||||
sexp_gc_preserve2(ctx, ls, tmp);
|
||||
|
|
@ -1152,6 +1152,11 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
|
|||
sexp_write_bignum(ctx, obj, out, 10);
|
||||
break;
|
||||
#endif
|
||||
case SEXP_OPCODE:
|
||||
sexp_write_string(ctx, "#<opcode ", out);
|
||||
sexp_write_string(ctx, sexp_opcode_name(obj), out);
|
||||
sexp_write_char(ctx, '>', out);
|
||||
break;
|
||||
default:
|
||||
i = sexp_pointer_tag(obj);
|
||||
sexp_write_string(ctx, "#<", out);
|
||||
|
|
@ -1232,14 +1237,14 @@ sexp sexp_write_one (sexp ctx, sexp obj, sexp out) {
|
|||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
sexp sexp_write (sexp ctx, sexp obj, sexp out) {
|
||||
sexp sexp_write_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp out) {
|
||||
if (! sexp_oportp(out))
|
||||
return sexp_type_exception(ctx, "write: not an output-port", out);
|
||||
else
|
||||
return sexp_write_one(ctx, obj, out);
|
||||
}
|
||||
|
||||
sexp sexp_display (sexp ctx, sexp obj, sexp out) {
|
||||
sexp sexp_display_op (sexp ctx sexp_api_params(self, n), sexp obj, sexp out) {
|
||||
sexp res=SEXP_VOID;
|
||||
if (! sexp_oportp(out))
|
||||
res = sexp_type_exception(ctx, "display: not an output-port", out);
|
||||
|
|
@ -1252,7 +1257,7 @@ sexp sexp_display (sexp ctx, sexp obj, sexp out) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_flush_output (sexp ctx, sexp out) {
|
||||
sexp sexp_flush_output_op (sexp ctx sexp_api_params(self, n), sexp out) {
|
||||
sexp_flush(ctx, out);
|
||||
return SEXP_VOID;
|
||||
}
|
||||
|
|
@ -1653,7 +1658,7 @@ sexp sexp_read_raw (sexp ctx, sexp in) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_read (sexp ctx, sexp in) {
|
||||
sexp sexp_read_op (sexp ctx sexp_api_params(self, n), sexp in) {
|
||||
sexp res;
|
||||
if (sexp_iportp(in))
|
||||
res = sexp_read_raw(ctx, in);
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue