mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 06:09:18 +02:00
passing context through all calls that can allocate memory
in preparation for a native, thread-safe gc.
This commit is contained in:
Alex Shinn
parent
8cf371cfe5
commit
4d78a28d8c
10 changed files with 658 additions and 584 deletions
4
Makefile
4
Makefile
|
|
@ -10,7 +10,9 @@ INCDIR=$(PREFIX)/include/chibi-scheme
|
|||
MODDIR=$(PREFIX)/share/chibi-scheme
|
||||
|
||||
LDFLAGS=-lm
|
||||
CFLAGS=-Wall -g -Os
|
||||
|
||||
# -Oz for smaller size on darwin
|
||||
CFLAGS=-Wall -g -Os -save-temps
|
||||
|
||||
GC_OBJ=./gc/gc.a
|
||||
|
||||
|
|
|
|||
30
defaults.h
30
defaults.h
|
|
@ -20,6 +20,10 @@
|
|||
#define USE_BOEHM 1
|
||||
#endif
|
||||
|
||||
#ifndef USE_MALLOC
|
||||
#define USE_MALLOC 0
|
||||
#endif
|
||||
|
||||
#ifndef USE_FLONUMS
|
||||
#define USE_FLONUMS 1
|
||||
#endif
|
||||
|
|
@ -58,16 +62,22 @@
|
|||
|
||||
#if USE_BOEHM
|
||||
#include "gc/include/gc.h"
|
||||
#define sexp_alloc GC_malloc
|
||||
#define sexp_alloc_atomic GC_malloc_atomic
|
||||
#define sexp_realloc GC_realloc
|
||||
#define sexp_free(x)
|
||||
#define sexp_deep_free(x)
|
||||
#else
|
||||
#define sexp_alloc malloc
|
||||
#define sexp_alloc(ctx, size) GC_malloc(size)
|
||||
#define sexp_alloc_atomic(ctx, size) GC_malloc_atomic(size)
|
||||
#define sexp_realloc(ctx, x, size) GC_realloc(x, size)
|
||||
#define sexp_free(ctx, x)
|
||||
#define sexp_deep_free(ctx, x)
|
||||
#elif USE_MALLOC
|
||||
#define sexp_alloc(ctx, size) malloc(size)
|
||||
#define sexp_alloc_atomic(ctx, size) malloc(size)
|
||||
#define sexp_realloc(ctx, x, size) realloc(x, size)
|
||||
#define sexp_free(ctx, x) free(x)
|
||||
void sexp_deep_free(sexp ctx, sexp obj);
|
||||
#else /* native gc */
|
||||
void *sexp_alloc(sexp ctx, size_t size);
|
||||
#define sexp_alloc_atomic sexp_alloc
|
||||
#define sexp_realloc realloc
|
||||
#define sexp_free free
|
||||
void sexp_deep_free(sexp obj);
|
||||
void *sexp_realloc(sexp ctx, sexp x, size_t size);
|
||||
#define sexp_free(ctx, x)
|
||||
#define sexp_deep_free(ctx, x)
|
||||
#endif
|
||||
|
||||
|
|
|
|||
1
eval.h
1
eval.h
|
|
@ -24,6 +24,7 @@ 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);
|
||||
|
||||
enum core_form_names {
|
||||
CORE_DEFINE = 1,
|
||||
|
|
|
|||
53
gc.c
53
gc.c
|
|
@ -11,7 +11,37 @@ static char* sexp_heap;
|
|||
static char* sexp_heap_end;
|
||||
static sexp sexp_free_list;
|
||||
|
||||
void *sexp_alloc (size_t size) {
|
||||
sexp_uint_t sexp_allocated_bytes (sexp x) {
|
||||
switch (sexp_tag(x)) {
|
||||
case SEXP_PAIR: return sexp_sizeof(pair);
|
||||
case SEXP_SYMBOL: return sexp_sizeof(symbol);
|
||||
case SEXP_STRING: return sexp_sizeof(string)+sexp_string_length(x);
|
||||
case SEXP_VECTOR:
|
||||
return sexp_sizeof(vector)+(sexp_vector_length(x)*sizeof(sexp));
|
||||
case SEXP_FLONUM: return sexp_sizeof(flonum);
|
||||
case SEXP_BIGNUM: return sexp_sizeof(bignum);
|
||||
case SEXP_IPORT:
|
||||
case SEXP_OPORT: return sexp_sizeof(port);
|
||||
case SEXP_EXCEPTION: return sexp_sizeof(exception);
|
||||
case SEXP_PROCEDURE: return sexp_sizeof(procedure);
|
||||
case SEXP_MACRO: return sexp_sizeof(macro);
|
||||
case SEXP_SYNCLO: return sexp_sizeof(synclo);
|
||||
case SEXP_ENV: return sexp_sizeof(env);
|
||||
case SEXP_BYTECODE: return sexp_sizeof(bytecode)+sexp_bytecode_length(x);
|
||||
case SEXP_CORE: return sexp_sizeof(core);
|
||||
case SEXP_OPCODE: return sexp_sizeof(opcode);
|
||||
case SEXP_LAMBDA: return sexp_sizeof(lambda);
|
||||
case SEXP_CND: return sexp_sizeof(cnd);
|
||||
case SEXP_REF: return sexp_sizeof(ref);
|
||||
case SEXP_SET: return sexp_sizeof(set);
|
||||
case SEXP_SEQ: return sexp_sizeof(seq);
|
||||
case SEXP_LIT: return sexp_sizeof(lit);
|
||||
case SEXP_CONTEXT: return sexp_sizeof(context);
|
||||
default: return 0;
|
||||
}
|
||||
}
|
||||
|
||||
void *sexp_alloc (sexp ctx, size_t size) {
|
||||
sexp ls1, ls2, ls3;
|
||||
try_alloc:
|
||||
ls1=sexp_free_list;
|
||||
|
|
@ -27,7 +57,7 @@ void *sexp_alloc (size_t size) {
|
|||
}
|
||||
return ls2;
|
||||
}
|
||||
if (sexp_unbox_integer(sexp_gc()) >= size) {
|
||||
if (sexp_unbox_integer(sexp_gc(ctx)) >= size) {
|
||||
goto try_alloc;
|
||||
} else {
|
||||
fprintf(stderr, "chibi: out of memory trying to allocate %ld bytes, aborting\n", size);
|
||||
|
|
@ -41,7 +71,7 @@ void sexp_mark (sexp x) {
|
|||
loop:
|
||||
if ((! sexp_pointerp(x)) || sexp_mark(x))
|
||||
return;
|
||||
sexp_mark(x) = 1;
|
||||
sexp_gc_mark(x) = 1;
|
||||
switch (sexp_tag(x)) {
|
||||
case SEXP_PAIR:
|
||||
sexp_mark(sexp_car(x));
|
||||
|
|
@ -56,9 +86,10 @@ void sexp_mark (sexp x) {
|
|||
|
||||
sexp sexp_sweep () {
|
||||
sexp_uint_t freed=0, size;
|
||||
sexp p=(sexp)sexp_heap, f=sexp_free_list;
|
||||
/* XXXX make p skip over areas already in the free_list */
|
||||
sexp p=(sexp)sexp_heap, f1=sexp_free_list, f2;
|
||||
while (p<sexp_heap_end) {
|
||||
for (f2=sexp_cdr(f1); sexp_pairp(f2) && (f2 < p); f1=f2, f2=sexp_cdr(f2))
|
||||
;
|
||||
size = sexp_allocated_bytes(p);
|
||||
if (! sexp_mark(p)) {
|
||||
freed += size;
|
||||
|
|
@ -74,8 +105,16 @@ sexp sexp_sweep () {
|
|||
return sexp_make_integer(freed);
|
||||
}
|
||||
|
||||
sexp sexp_gc () {
|
||||
/* XXXX change FFI to pass context for marking */
|
||||
sexp sexp_gc (sexp ctx) {
|
||||
int i;
|
||||
sexp ctx2, stack = sexp_context_stack(ctx);
|
||||
for (i=0; i<sexp_context_top(ctx); i++)
|
||||
sexp_mark(stack[i]);
|
||||
for ( ; ctx; ctx=sexp_context_(ctx)) {
|
||||
sexp_gc_mark(ctx) = 1;
|
||||
sexp_gc_mark(sexp_context_bc(ctx)) = 1;
|
||||
sexp_mark(sexp_context_env(ctx));
|
||||
}
|
||||
return sexp_sweep();
|
||||
}
|
||||
|
||||
|
|
|
|||
40
init.scm
40
init.scm
|
|
@ -43,19 +43,23 @@
|
|||
|
||||
(define (list-ref ls k) (car (list-tail ls k)))
|
||||
|
||||
(define (append-reverse a b)
|
||||
(if (pair? a)
|
||||
(append-reverse (cdr a) (cons (car a) b))
|
||||
b))
|
||||
(define (append-helper ls res)
|
||||
(if (null? ls)
|
||||
res
|
||||
(append-helper (cdr ls) (append2 (car ls) res))))
|
||||
|
||||
(define (append a b)
|
||||
(append-reverse (reverse a) b))
|
||||
(define (append . o)
|
||||
(if (null? o)
|
||||
'()
|
||||
((lambda (lol)
|
||||
(append-helper (cdr lol) (car lol)))
|
||||
(reverse o))))
|
||||
|
||||
(define (apply proc . args)
|
||||
(if (null? args)
|
||||
(proc)
|
||||
((lambda (lol)
|
||||
(apply1 proc (append (reverse (cdr lol)) (car lol))))
|
||||
(apply1 proc (append2 (reverse (cdr lol)) (car lol))))
|
||||
(reverse args))))
|
||||
|
||||
;; map with a fast-path for single lists
|
||||
|
|
@ -335,17 +339,17 @@
|
|||
(define (string-append . args) (string-concatenate args))
|
||||
(define (string-copy s) (substring s 0 (string-length s)))
|
||||
|
||||
(define (string=? s1 s2) (eq? (string-cmp s1 s2) 0))
|
||||
(define (string<? s1 s2) (< (string-cmp s1 s2) 0))
|
||||
(define (string<=? s1 s2) (<= (string-cmp s1 s2) 0))
|
||||
(define (string>? s1 s2) (> (string-cmp s1 s2) 0))
|
||||
(define (string>=? s1 s2) (>= (string-cmp s1 s2) 0))
|
||||
(define (string=? s1 s2) (eq? (string-cmp s1 s2 #f) 0))
|
||||
(define (string<? s1 s2) (< (string-cmp s1 s2 #f) 0))
|
||||
(define (string<=? s1 s2) (<= (string-cmp s1 s2 #f) 0))
|
||||
(define (string>? s1 s2) (> (string-cmp s1 s2 #f) 0))
|
||||
(define (string>=? s1 s2) (>= (string-cmp s1 s2 #f) 0))
|
||||
|
||||
(define (string-ci=? s1 s2) (eq? (string-cmp-ci s1 s2) 0))
|
||||
(define (string-ci<? s1 s2) (< (string-cmp-ci s1 s2) 0))
|
||||
(define (string-ci<=? s1 s2) (<= (string-cmp-ci s1 s2) 0))
|
||||
(define (string-ci>? s1 s2) (> (string-cmp-ci s1 s2) 0))
|
||||
(define (string-ci>=? s1 s2) (>= (string-cmp-ci s1 s2) 0))
|
||||
(define (string-ci=? s1 s2) (eq? (string-cmp s1 s2 #t) 0))
|
||||
(define (string-ci<? s1 s2) (< (string-cmp s1 s2 #t) 0))
|
||||
(define (string-ci<=? s1 s2) (<= (string-cmp s1 s2 #t) 0))
|
||||
(define (string-ci>? s1 s2) (> (string-cmp s1 s2 #t) 0))
|
||||
(define (string-ci>=? s1 s2) (>= (string-cmp s1 s2 #t) 0))
|
||||
|
||||
;; list utils
|
||||
|
||||
|
|
@ -418,6 +422,8 @@
|
|||
(define magnitude abs)
|
||||
(define (angle z) (if (< z 0) 3.141592653589793 0))
|
||||
|
||||
(define (atan x . o) (if (null? o) (atan1 x) (atan1 (/ x (car o)))))
|
||||
|
||||
(define (digit-char n) (integer->char (+ n (char->integer #\0))))
|
||||
(define (digit-value ch)
|
||||
(if (char-numeric? ch)
|
||||
|
|
|
|||
36
main.c
36
main.c
|
|
@ -11,15 +11,15 @@ void repl (sexp context) {
|
|||
while (1) {
|
||||
sexp_write_string("> ", out);
|
||||
sexp_flush(out);
|
||||
obj = sexp_read(in);
|
||||
obj = sexp_read(context, in);
|
||||
if (obj == SEXP_EOF)
|
||||
break;
|
||||
if (sexp_exceptionp(obj)) {
|
||||
sexp_print_exception(obj, err);
|
||||
sexp_print_exception(context, obj, err);
|
||||
} else {
|
||||
tmp = sexp_env_bindings(env);
|
||||
res = eval_in_context(obj, context);
|
||||
#ifdef USE_WARN_UNDEFS
|
||||
#if USE_WARN_UNDEFS
|
||||
sexp_warn_undefs(sexp_env_bindings(env), tmp, err);
|
||||
#endif
|
||||
if (res != SEXP_VOID) {
|
||||
|
|
@ -34,12 +34,13 @@ void run_main (int argc, char **argv) {
|
|||
sexp env, out=NULL, res, context, perr_cell, err_cell, err_handler;
|
||||
sexp_uint_t i, quit=0, init_loaded=0;
|
||||
|
||||
env = sexp_make_standard_env(sexp_make_integer(5));
|
||||
env_define(env, the_interaction_env_symbol, env);
|
||||
context = sexp_make_context(NULL, NULL, NULL);
|
||||
env = sexp_make_standard_env(context, sexp_make_integer(5));
|
||||
env_define(context, env, the_interaction_env_symbol, env);
|
||||
out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE);
|
||||
err_cell = env_cell(env, the_cur_err_symbol);
|
||||
perr_cell = env_cell(env, sexp_intern("print-exception"));
|
||||
context = sexp_make_context(NULL, env);
|
||||
perr_cell = env_cell(env, sexp_intern(context, "print-exception"));
|
||||
sexp_context_env(context) = env;
|
||||
sexp_context_tailp(context) = 0;
|
||||
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
|
||||
emit(OP_GLOBAL_KNOWN_REF, context);
|
||||
|
|
@ -51,11 +52,12 @@ void run_main (int argc, char **argv) {
|
|||
}
|
||||
emit_push(SEXP_VOID, context);
|
||||
emit(OP_DONE, context);
|
||||
err_handler = sexp_make_procedure(sexp_make_integer(0),
|
||||
err_handler = sexp_make_procedure(context,
|
||||
sexp_make_integer(0),
|
||||
sexp_make_integer(0),
|
||||
finalize_bytecode(context),
|
||||
sexp_make_vector(0, SEXP_VOID));
|
||||
env_define(env, the_err_handler_symbol, err_handler);
|
||||
sexp_make_vector(context, 0, SEXP_VOID));
|
||||
env_define(context, env, the_err_handler_symbol, err_handler);
|
||||
|
||||
/* parse options */
|
||||
for (i=1; i < argc && argv[i][0] == '-'; i++) {
|
||||
|
|
@ -64,12 +66,12 @@ void run_main (int argc, char **argv) {
|
|||
case 'e':
|
||||
case 'p':
|
||||
if (! init_loaded++)
|
||||
sexp_load(sexp_c_string(sexp_init_file), env);
|
||||
res = sexp_read_from_string(argv[i+1]);
|
||||
sexp_load(context, sexp_c_string(context, sexp_init_file), env);
|
||||
res = sexp_read_from_string(context, argv[i+1]);
|
||||
if (! sexp_exceptionp(res))
|
||||
res = eval_in_context(res, context);
|
||||
if (sexp_exceptionp(res)) {
|
||||
sexp_print_exception(res, out);
|
||||
sexp_print_exception(context, res, out);
|
||||
} else if (argv[i][1] == 'p') {
|
||||
sexp_write(res, out);
|
||||
sexp_write_char('\n', out);
|
||||
|
|
@ -80,8 +82,8 @@ void run_main (int argc, char **argv) {
|
|||
#endif
|
||||
case 'l':
|
||||
if (! init_loaded++)
|
||||
sexp_load(sexp_c_string(sexp_init_file), env);
|
||||
sexp_load(sexp_c_string(argv[++i]), env);
|
||||
sexp_load(context, sexp_c_string(context, sexp_init_file), env);
|
||||
sexp_load(context, sexp_c_string(context, argv[++i]), env);
|
||||
break;
|
||||
case 'q':
|
||||
init_loaded = 1;
|
||||
|
|
@ -93,10 +95,10 @@ void run_main (int argc, char **argv) {
|
|||
|
||||
if (! quit) {
|
||||
if (! init_loaded)
|
||||
sexp_load(sexp_c_string(sexp_init_file), env);
|
||||
sexp_load(context, sexp_c_string(context, sexp_init_file), env);
|
||||
if (i < argc)
|
||||
for ( ; i < argc; i++)
|
||||
sexp_load(sexp_c_string(argv[i]), env);
|
||||
sexp_load(context, sexp_c_string(context, argv[i]), env);
|
||||
else
|
||||
repl(context);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -77,6 +77,8 @@ _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),
|
||||
|
|
@ -89,8 +91,7 @@ _FN2(SEXP_EXCEPTION, SEXP_OPORT, "print-exception", 0, sexp_print_exception),
|
|||
_FN1(SEXP_EXCEPTION, "exception-type", 0, sexp_exception_type_func),
|
||||
_FN6(SEXP_SYMBOL, SEXP_STRING, "make-exception", 0, sexp_make_exception),
|
||||
_FN2OPT(SEXP_FIXNUM, SEXP_CHAR, "make-string", sexp_make_character(' '), sexp_make_string),
|
||||
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp", 0, sexp_string_cmp),
|
||||
_FN2(SEXP_STRING, SEXP_STRING, "string-cmp-ci", 0, sexp_string_cmp_ci),
|
||||
_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),
|
||||
_FN1(SEXP_PAIR, "string-concatenate", 0, sexp_string_concatenate),
|
||||
|
|
@ -110,7 +111,7 @@ _FN1(0, "cos", 0, sexp_cos),
|
|||
_FN1(0, "tan", 0, sexp_tan),
|
||||
_FN1(0, "asin", 0, sexp_asin),
|
||||
_FN1(0, "acos", 0, sexp_acos),
|
||||
_FN1(0, "atan", 0, sexp_atan),
|
||||
_FN1(0, "atan1", 0, sexp_atan),
|
||||
_FN1(0, "sqrt", 0, sexp_sqrt),
|
||||
_FN1(0, "round", 0, sexp_round),
|
||||
_FN1(0, "truncate", 0, sexp_trunc),
|
||||
|
|
|
|||
373
sexp.c
373
sexp.c
|
|
@ -53,8 +53,8 @@ static int is_separator(int c) {
|
|||
|
||||
static sexp symbol_table[SEXP_SYMBOL_TABLE_SIZE];
|
||||
|
||||
sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag) {
|
||||
sexp res = (sexp) sexp_alloc(size);
|
||||
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag) {
|
||||
sexp res = (sexp) sexp_alloc(ctx, size);
|
||||
if (! res)
|
||||
errx(EX_OSERR, "out of memory: couldn't allocate %ld bytes for %ld",
|
||||
size ,tag);
|
||||
|
|
@ -63,7 +63,7 @@ sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag) {
|
|||
}
|
||||
|
||||
#if ! USE_BOEHM
|
||||
void sexp_deep_free (sexp obj) {
|
||||
void sexp_deep_free (sexp ctx, sexp obj) {
|
||||
int len, i;
|
||||
sexp *elts;
|
||||
if (sexp_pointerp(obj)) {
|
||||
|
|
@ -77,23 +77,23 @@ void sexp_deep_free (sexp obj) {
|
|||
elts = sexp_vector_data(obj);
|
||||
for (i=0; i<len; i++)
|
||||
sexp_deep_free(elts[i]);
|
||||
sexp_free(elts);
|
||||
sexp_free(ctx, elts);
|
||||
break;
|
||||
case SEXP_STRING:
|
||||
case SEXP_SYMBOL:
|
||||
sexp_free(sexp_string_data(obj));
|
||||
sexp_free(ctx, sexp_string_data(obj));
|
||||
break;
|
||||
}
|
||||
sexp_free(obj);
|
||||
sexp_free(ctx, obj);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/***************************** exceptions *****************************/
|
||||
|
||||
sexp sexp_make_exception (sexp kind, sexp message, sexp irritants,
|
||||
sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants,
|
||||
sexp procedure, sexp file, sexp line) {
|
||||
sexp exn = sexp_alloc_type(exception, SEXP_EXCEPTION);
|
||||
sexp exn = sexp_alloc_type(ctx, exception, SEXP_EXCEPTION);
|
||||
sexp_exception_kind(exn) = kind;
|
||||
sexp_exception_message(exn) = message;
|
||||
sexp_exception_irritants(exn) = irritants;
|
||||
|
|
@ -103,28 +103,28 @@ sexp sexp_make_exception (sexp kind, sexp message, sexp irritants,
|
|||
return exn;
|
||||
}
|
||||
|
||||
sexp sexp_user_exception (sexp self, char *message, sexp irritants) {
|
||||
return sexp_make_exception(sexp_intern("user"),
|
||||
sexp_c_string(message),
|
||||
sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp irritants) {
|
||||
return sexp_make_exception(ctx, sexp_intern(ctx, "user"),
|
||||
sexp_c_string(ctx, message),
|
||||
((sexp_pairp(irritants) || sexp_nullp(irritants))
|
||||
? irritants : sexp_list1(irritants)),
|
||||
? irritants : sexp_list1(ctx, irritants)),
|
||||
self, SEXP_FALSE, SEXP_FALSE);
|
||||
}
|
||||
|
||||
sexp sexp_type_exception (char *message, sexp obj) {
|
||||
return sexp_make_exception(sexp_intern("type"),
|
||||
sexp_c_string(message), sexp_list1(obj),
|
||||
sexp sexp_type_exception (sexp ctx, char *message, sexp obj) {
|
||||
return sexp_make_exception(ctx, sexp_intern(ctx, "type"),
|
||||
sexp_c_string(ctx, message), sexp_list1(ctx, obj),
|
||||
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
|
||||
}
|
||||
|
||||
sexp sexp_range_exception (sexp obj, sexp start, sexp end) {
|
||||
return sexp_make_exception(sexp_intern("range"),
|
||||
sexp_c_string("bad index range"),
|
||||
sexp_list3(obj, start, end),
|
||||
sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end) {
|
||||
return sexp_make_exception(ctx, sexp_intern(ctx, "range"),
|
||||
sexp_c_string(ctx, "bad index range"),
|
||||
sexp_list3(ctx, obj, start, end),
|
||||
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
|
||||
}
|
||||
|
||||
sexp sexp_print_exception (sexp exn, sexp out) {
|
||||
sexp sexp_print_exception (sexp ctx, sexp exn, sexp out) {
|
||||
sexp ls;
|
||||
sexp_write_string("ERROR", out);
|
||||
if (sexp_exceptionp(exn)) {
|
||||
|
|
@ -176,27 +176,25 @@ sexp sexp_print_exception (sexp exn, sexp out) {
|
|||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
static sexp sexp_read_error (char *message, sexp irritants, sexp port) {
|
||||
static sexp sexp_read_error (sexp ctx, char *message, sexp irritants, sexp port) {
|
||||
sexp name = (sexp_port_name(port)
|
||||
? sexp_c_string(sexp_port_name(port)) : SEXP_FALSE);
|
||||
return sexp_make_exception(the_read_error_symbol,
|
||||
sexp_c_string(message),
|
||||
irritants,
|
||||
SEXP_FALSE,
|
||||
name,
|
||||
? sexp_c_string(ctx, sexp_port_name(port)) : SEXP_FALSE);
|
||||
return sexp_make_exception(ctx, the_read_error_symbol,
|
||||
sexp_c_string(ctx, message),
|
||||
irritants, SEXP_FALSE, name,
|
||||
sexp_make_integer(sexp_port_line(port)));
|
||||
}
|
||||
|
||||
/*************************** list utilities ***************************/
|
||||
|
||||
sexp sexp_cons (sexp head, sexp tail) {
|
||||
sexp pair = sexp_alloc_type(pair, SEXP_PAIR);
|
||||
sexp sexp_cons (sexp ctx, sexp head, sexp tail) {
|
||||
sexp pair = sexp_alloc_type(ctx, pair, SEXP_PAIR);
|
||||
sexp_car(pair) = head;
|
||||
sexp_cdr(pair) = tail;
|
||||
return pair;
|
||||
}
|
||||
|
||||
sexp sexp_listp (sexp hare) {
|
||||
sexp sexp_listp (sexp ctx, sexp hare) {
|
||||
sexp turtle;
|
||||
if (! sexp_pairp(hare))
|
||||
return sexp_make_boolean(hare == SEXP_NULL);
|
||||
|
|
@ -210,7 +208,7 @@ sexp sexp_listp (sexp hare) {
|
|||
return sexp_make_boolean(hare == SEXP_NULL);
|
||||
}
|
||||
|
||||
sexp sexp_memq (sexp x, sexp ls) {
|
||||
sexp sexp_memq (sexp ctx, sexp x, sexp ls) {
|
||||
while (sexp_pairp(ls))
|
||||
if (x == sexp_car(ls))
|
||||
return ls;
|
||||
|
|
@ -219,7 +217,7 @@ sexp sexp_memq (sexp x, sexp ls) {
|
|||
return SEXP_FALSE;
|
||||
}
|
||||
|
||||
sexp sexp_assq (sexp x, sexp ls) {
|
||||
sexp sexp_assq (sexp ctx, sexp x, sexp ls) {
|
||||
while (sexp_pairp(ls))
|
||||
if (sexp_pairp(sexp_car(ls)) && (x == sexp_caar(ls)))
|
||||
return sexp_car(ls);
|
||||
|
|
@ -228,14 +226,14 @@ sexp sexp_assq (sexp x, sexp ls) {
|
|||
return SEXP_FALSE;
|
||||
}
|
||||
|
||||
sexp sexp_reverse (sexp ls) {
|
||||
sexp sexp_reverse (sexp ctx, sexp ls) {
|
||||
sexp res = SEXP_NULL;
|
||||
for ( ; sexp_pairp(ls); ls=sexp_cdr(ls))
|
||||
res = sexp_cons(sexp_car(ls), res);
|
||||
res = sexp_cons(ctx, sexp_car(ls), res);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_nreverse (sexp ls) {
|
||||
sexp sexp_nreverse (sexp ctx, sexp ls) {
|
||||
sexp a, b, tmp;
|
||||
if (ls == SEXP_NULL) {
|
||||
return ls;
|
||||
|
|
@ -253,20 +251,20 @@ sexp sexp_nreverse (sexp ls) {
|
|||
}
|
||||
}
|
||||
|
||||
sexp sexp_append (sexp a, sexp b) {
|
||||
for (a=sexp_reverse(a); sexp_pairp(a); a=sexp_cdr(a))
|
||||
b = sexp_cons(sexp_car(a), b);
|
||||
sexp sexp_append2 (sexp ctx, sexp a, sexp b) {
|
||||
for (a=sexp_reverse(ctx, a); sexp_pairp(a); a=sexp_cdr(a))
|
||||
b = sexp_cons(ctx, sexp_car(a), b);
|
||||
return b;
|
||||
}
|
||||
|
||||
sexp sexp_length (sexp ls) {
|
||||
sexp sexp_length (sexp ctx, sexp ls) {
|
||||
sexp_uint_t res=0;
|
||||
for ( ; sexp_pairp(ls); res++, ls=sexp_cdr(ls))
|
||||
;
|
||||
return sexp_make_integer(res);
|
||||
}
|
||||
|
||||
sexp sexp_equalp (sexp a, sexp b) {
|
||||
sexp sexp_equalp (sexp ctx, sexp a, sexp b) {
|
||||
sexp_uint_t len;
|
||||
sexp *v1, *v2;
|
||||
loop:
|
||||
|
|
@ -284,7 +282,7 @@ sexp sexp_equalp (sexp a, sexp b) {
|
|||
return SEXP_FALSE;
|
||||
switch (sexp_pointer_tag(a)) {
|
||||
case SEXP_PAIR:
|
||||
if (sexp_equalp(sexp_car(a), sexp_car(b)) == SEXP_FALSE)
|
||||
if (sexp_equalp(ctx, sexp_car(a), sexp_car(b)) == SEXP_FALSE)
|
||||
return SEXP_FALSE;
|
||||
a = sexp_cdr(a);
|
||||
b = sexp_cdr(b);
|
||||
|
|
@ -296,7 +294,7 @@ sexp sexp_equalp (sexp a, sexp b) {
|
|||
v1 = sexp_vector_data(a);
|
||||
v2 = sexp_vector_data(b);
|
||||
for (len--; len > 0; len--)
|
||||
if (sexp_equalp(v1[len], v2[len]) == SEXP_FALSE)
|
||||
if (sexp_equalp(ctx, v1[len], v2[len]) == SEXP_FALSE)
|
||||
return SEXP_FALSE;
|
||||
return SEXP_TRUE;
|
||||
case SEXP_STRING:
|
||||
|
|
@ -313,18 +311,18 @@ sexp sexp_equalp (sexp a, sexp b) {
|
|||
|
||||
/********************* strings, symbols, vectors **********************/
|
||||
|
||||
sexp sexp_make_flonum(double f) {
|
||||
sexp x = sexp_alloc_type(flonum, SEXP_FLONUM);
|
||||
sexp sexp_make_flonum(sexp ctx, double f) {
|
||||
sexp x = sexp_alloc_type(ctx, flonum, SEXP_FLONUM);
|
||||
sexp_flonum_value(x) = f;
|
||||
return x;
|
||||
}
|
||||
|
||||
sexp sexp_make_string(sexp len, sexp ch) {
|
||||
sexp sexp_make_string(sexp ctx, sexp len, sexp ch) {
|
||||
char *cstr;
|
||||
sexp s = sexp_alloc_type(string, SEXP_STRING);
|
||||
sexp s = sexp_alloc_type(ctx, string, SEXP_STRING);
|
||||
sexp_sint_t clen = sexp_unbox_integer(len);
|
||||
if (clen < 0) return sexp_type_exception("negative length", len);
|
||||
cstr = sexp_alloc(clen+1);
|
||||
if (clen < 0) return sexp_type_exception(ctx, "negative length", len);
|
||||
cstr = sexp_alloc(ctx, clen+1);
|
||||
if (sexp_charp(ch))
|
||||
memset(cstr, sexp_unbox_character(ch), clen);
|
||||
cstr[clen] = '\0';
|
||||
|
|
@ -333,31 +331,30 @@ sexp sexp_make_string(sexp len, sexp ch) {
|
|||
return s;
|
||||
}
|
||||
|
||||
sexp sexp_c_string(char *str) {
|
||||
sexp sexp_c_string(sexp ctx, char *str) {
|
||||
sexp_uint_t len = strlen(str);
|
||||
sexp s = sexp_make_string(sexp_make_integer(len), SEXP_VOID);
|
||||
sexp s = sexp_make_string(ctx, sexp_make_integer(len), SEXP_VOID);
|
||||
memcpy(sexp_string_data(s), str, len);
|
||||
return s;
|
||||
}
|
||||
|
||||
sexp sexp_substring (sexp str, sexp start, sexp end) {
|
||||
sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end) {
|
||||
sexp res;
|
||||
if (! sexp_stringp(str))
|
||||
return sexp_type_exception("not a string", str);
|
||||
return sexp_type_exception(ctx, "not a string", str);
|
||||
if (! sexp_integerp(start))
|
||||
return sexp_type_exception("not a number", start);
|
||||
return sexp_type_exception(ctx, "not a number", start);
|
||||
if (end == SEXP_FALSE)
|
||||
end = sexp_make_integer(sexp_string_length(str));
|
||||
if (! sexp_integerp(end))
|
||||
return sexp_type_exception("not a number", end);
|
||||
return sexp_type_exception(ctx, "not a number", end);
|
||||
if ((sexp_unbox_integer(start) < 0)
|
||||
|| (sexp_unbox_integer(start) > sexp_string_length(str))
|
||||
|| (sexp_unbox_integer(end) < 0)
|
||||
|| (sexp_unbox_integer(end) > sexp_string_length(str))
|
||||
|| (end < start))
|
||||
return sexp_range_exception(str, start, end);
|
||||
res = sexp_make_string(sexp_fx_sub(end, start),
|
||||
SEXP_VOID);
|
||||
return sexp_range_exception(ctx, str, start, end);
|
||||
res = sexp_make_string(ctx, sexp_fx_sub(end, start), SEXP_VOID);
|
||||
memcpy(sexp_string_data(res),
|
||||
sexp_string_data(str)+sexp_unbox_integer(start),
|
||||
sexp_string_length(res));
|
||||
|
|
@ -372,7 +369,7 @@ sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc) {
|
|||
return acc;
|
||||
}
|
||||
|
||||
sexp sexp_intern(char *str) {
|
||||
sexp sexp_intern(sexp ctx, char *str) {
|
||||
struct huff_entry he;
|
||||
sexp_uint_t len, res=FNV_OFFSET_BASIS, space=3, newbits, bucket;
|
||||
char c, *mystr, *p=str;
|
||||
|
|
@ -404,26 +401,26 @@ sexp sexp_intern(char *str) {
|
|||
return sexp_car(ls);
|
||||
|
||||
/* not found, make a new symbol */
|
||||
sym = sexp_alloc_type(symbol, SEXP_SYMBOL);
|
||||
mystr = sexp_alloc(len+1);
|
||||
sym = sexp_alloc_type(ctx, symbol, SEXP_SYMBOL);
|
||||
mystr = sexp_alloc(ctx, len+1);
|
||||
memcpy(mystr, str, len+1);
|
||||
mystr[len]=0;
|
||||
sexp_symbol_length(sym) = len;
|
||||
sexp_symbol_data(sym) = mystr;
|
||||
sexp_push(symbol_table[bucket], sym);
|
||||
sexp_push(ctx, symbol_table[bucket], sym);
|
||||
return sym;
|
||||
}
|
||||
|
||||
sexp sexp_string_to_symbol (sexp str) {
|
||||
return sexp_intern(sexp_string_data(str));
|
||||
sexp sexp_string_to_symbol (sexp ctx, sexp str) {
|
||||
return sexp_intern(ctx, sexp_string_data(str));
|
||||
}
|
||||
|
||||
sexp sexp_make_vector(sexp len, sexp dflt) {
|
||||
sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt) {
|
||||
sexp v, *x;
|
||||
int i, clen = sexp_unbox_integer(len);
|
||||
if (! clen) return the_empty_vector;
|
||||
v = sexp_alloc_type(vector, SEXP_VECTOR);
|
||||
x = (sexp*) sexp_alloc(clen*sizeof(sexp));
|
||||
v = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
|
||||
x = (sexp*) sexp_alloc(ctx, clen*sizeof(sexp));
|
||||
for (i=0; i<clen; i++)
|
||||
x[i] = dflt;
|
||||
sexp_vector_length(v) = clen;
|
||||
|
|
@ -431,8 +428,8 @@ sexp sexp_make_vector(sexp len, sexp dflt) {
|
|||
return v;
|
||||
}
|
||||
|
||||
sexp sexp_list_to_vector(sexp ls) {
|
||||
sexp x, vec = sexp_make_vector(sexp_length(ls), SEXP_VOID);
|
||||
sexp sexp_list_to_vector(sexp ctx, sexp ls) {
|
||||
sexp x, vec = sexp_make_vector(ctx, sexp_length(ctx, ls), SEXP_VOID);
|
||||
sexp *elts = sexp_vector_data(vec);
|
||||
int i;
|
||||
for (i=0, x=ls; sexp_pairp(x); i++, x=sexp_cdr(x))
|
||||
|
|
@ -440,8 +437,8 @@ sexp sexp_list_to_vector(sexp ls) {
|
|||
return vec;
|
||||
}
|
||||
|
||||
sexp sexp_vector(int count, ...) {
|
||||
sexp vec = sexp_make_vector(sexp_make_integer(count), SEXP_VOID);
|
||||
sexp sexp_vector(sexp ctx, int count, ...) {
|
||||
sexp vec = sexp_make_vector(ctx, sexp_make_integer(count), SEXP_VOID);
|
||||
sexp *elts = sexp_vector_data(vec);
|
||||
va_list ap;
|
||||
int i;
|
||||
|
|
@ -482,7 +479,7 @@ int sstream_write (void *vec, const char *src, int n) {
|
|||
pos = sexp_unbox_integer(sexp_stream_pos(vec));
|
||||
newpos = pos+n;
|
||||
if (newpos >= len) {
|
||||
newbuf = sexp_make_string(sexp_make_integer(newpos*2), SEXP_VOID);
|
||||
newbuf = sexp_make_string(NULL, sexp_make_integer(newpos*2), SEXP_VOID);
|
||||
memcpy(sexp_string_data(newbuf),
|
||||
sexp_string_data(sexp_stream_buf(vec)),
|
||||
pos);
|
||||
|
|
@ -507,54 +504,55 @@ off_t sstream_seek (void *vec, off_t offset, int whence) {
|
|||
return pos;
|
||||
}
|
||||
|
||||
sexp sexp_make_input_string_port (sexp str) {
|
||||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
FILE *in;
|
||||
sexp res, cookie;
|
||||
cookie = sexp_vector(3, str, sexp_make_integer(sexp_string_length(str)),
|
||||
cookie = sexp_vector(ctx, 3, str, sexp_make_integer(sexp_string_length(str)),
|
||||
sexp_make_integer(0));
|
||||
in = funopen(cookie, &sstream_read, NULL, &sstream_seek, NULL);
|
||||
res = sexp_make_input_port(in, NULL);
|
||||
res = sexp_make_input_port(ctx, in, NULL);
|
||||
sexp_port_cookie(res) = cookie;
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port () {
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
FILE *out;
|
||||
sexp res, size, cookie;
|
||||
size = sexp_make_integer(SEXP_INIT_STRING_PORT_SIZE);
|
||||
cookie = sexp_vector(3, sexp_make_string(size, SEXP_VOID),
|
||||
cookie = sexp_vector(ctx, 3, sexp_make_string(NULL, size, SEXP_VOID),
|
||||
size, sexp_make_integer(0));
|
||||
out = funopen(cookie, NULL, &sstream_write, &sstream_seek, NULL);
|
||||
res = sexp_make_output_port(out, NULL);
|
||||
res = sexp_make_output_port(ctx, out, NULL);
|
||||
sexp_port_cookie(res) = cookie;
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_get_output_string (sexp port) {
|
||||
sexp sexp_get_output_string (sexp ctx, sexp port) {
|
||||
sexp cookie = sexp_port_cookie(port);
|
||||
fflush(sexp_port_stream(port));
|
||||
return sexp_substring(sexp_stream_buf(cookie),
|
||||
return sexp_substring(ctx,
|
||||
sexp_stream_buf(cookie),
|
||||
sexp_make_integer(0),
|
||||
sexp_stream_pos(cookie));
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
sexp sexp_make_input_string_port (sexp str) {
|
||||
sexp sexp_make_input_string_port (sexp ctx, sexp str) {
|
||||
FILE *in = fmemopen(sexp_string_data(str), sexp_string_length(str), "r");
|
||||
return sexp_make_input_port(in, NULL);
|
||||
}
|
||||
|
||||
sexp sexp_make_output_string_port () {
|
||||
sexp sexp_make_output_string_port (sexp ctx) {
|
||||
FILE *out;
|
||||
sexp buf = sexp_alloc_type(string, SEXP_STRING), res;
|
||||
sexp buf = sexp_alloc_type(ctx, string, SEXP_STRING), res;
|
||||
out = open_memstream(&sexp_string_data(buf), &sexp_string_length(buf));
|
||||
res = sexp_make_input_port(out, NULL);
|
||||
sexp_port_cookie(res) = buf;
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_get_output_string (sexp port) {
|
||||
sexp sexp_get_output_string (sexp ctx, sexp port) {
|
||||
sexp cookie = sexp_port_cookie(port);
|
||||
fflush(sexp_port_stream(port));
|
||||
return sexp_substring(cookie,
|
||||
|
|
@ -566,16 +564,16 @@ sexp sexp_get_output_string (sexp port) {
|
|||
|
||||
#endif
|
||||
|
||||
sexp sexp_make_input_port (FILE* in, char *path) {
|
||||
sexp p = sexp_alloc_type(port, SEXP_IPORT);
|
||||
sexp sexp_make_input_port (sexp ctx, FILE* in, char *path) {
|
||||
sexp p = sexp_alloc_type(ctx, port, SEXP_IPORT);
|
||||
sexp_port_stream(p) = in;
|
||||
sexp_port_name(p) = path;
|
||||
sexp_port_line(p) = 0;
|
||||
return p;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_port (FILE* out, char *path) {
|
||||
sexp p = sexp_alloc_type(port, SEXP_OPORT);
|
||||
sexp sexp_make_output_port (sexp ctx, FILE* out, char *path) {
|
||||
sexp p = sexp_alloc_type(ctx, port, SEXP_OPORT);
|
||||
sexp_port_stream(p) = out;
|
||||
sexp_port_name(p) = path;
|
||||
sexp_port_line(p) = 0;
|
||||
|
|
@ -761,15 +759,15 @@ void sexp_write (sexp obj, sexp out) {
|
|||
}
|
||||
}
|
||||
|
||||
char* sexp_read_string(sexp in) {
|
||||
char* sexp_read_string(sexp ctx, sexp in) {
|
||||
char *buf, *tmp, *res;
|
||||
int c, i=0, size=128;
|
||||
|
||||
buf = sexp_alloc(size);
|
||||
buf = sexp_alloc(ctx, size);
|
||||
|
||||
for (c=sexp_read_char(in); c != '"'; c=sexp_read_char(in)) {
|
||||
if (c == EOF) {
|
||||
sexp_free(buf);
|
||||
sexp_free(ctx, buf);
|
||||
return NULL;
|
||||
}
|
||||
if (c == '\\') {
|
||||
|
|
@ -783,25 +781,25 @@ char* sexp_read_string(sexp in) {
|
|||
buf[i++] = c;
|
||||
}
|
||||
if (i >= size) {
|
||||
tmp = sexp_alloc(2*size);
|
||||
tmp = sexp_alloc(ctx, 2*size);
|
||||
memcpy(tmp, buf, i);
|
||||
sexp_free(buf);
|
||||
sexp_free(ctx, buf);
|
||||
buf = tmp;
|
||||
}
|
||||
}
|
||||
|
||||
buf[i] = '\0';
|
||||
res = sexp_alloc(i);
|
||||
res = sexp_alloc(ctx, i);
|
||||
memcpy(res, buf, i);
|
||||
sexp_free(buf);
|
||||
sexp_free(ctx, buf);
|
||||
return res;
|
||||
}
|
||||
|
||||
char* sexp_read_symbol(sexp in, int init) {
|
||||
char* sexp_read_symbol(sexp ctx, sexp in, int init) {
|
||||
char *buf, *tmp, *res;
|
||||
int c, i=0, size=128;
|
||||
|
||||
buf = sexp_alloc(size);
|
||||
buf = sexp_alloc(ctx, size);
|
||||
|
||||
if (init != EOF)
|
||||
buf[i++] = init;
|
||||
|
|
@ -814,21 +812,21 @@ char* sexp_read_symbol(sexp in, int init) {
|
|||
}
|
||||
buf[i++] = c;
|
||||
if (i >= size) {
|
||||
tmp = sexp_alloc(2*size);
|
||||
tmp = sexp_alloc(ctx, 2*size);
|
||||
memcpy(tmp, buf, i);
|
||||
sexp_free(buf);
|
||||
sexp_free(ctx, buf);
|
||||
buf = tmp;
|
||||
}
|
||||
}
|
||||
|
||||
buf[i] = '\0';
|
||||
res = sexp_alloc(i);
|
||||
res = sexp_alloc(ctx, i);
|
||||
memcpy(res, buf, i);
|
||||
sexp_free(buf);
|
||||
sexp_free(ctx, buf);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_read_float_tail(sexp in, sexp_sint_t whole) {
|
||||
sexp sexp_read_float_tail(sexp ctx, sexp in, sexp_sint_t whole) {
|
||||
sexp exponent;
|
||||
double res=0.0, scale=0.1, e=0.0;
|
||||
int c;
|
||||
|
|
@ -836,17 +834,17 @@ sexp sexp_read_float_tail(sexp in, sexp_sint_t whole) {
|
|||
res += digit_value(c)*scale;
|
||||
sexp_push_char(c, in);
|
||||
if (c=='e' || c=='E') {
|
||||
exponent = sexp_read_number(in, 10);
|
||||
exponent = sexp_read_number(ctx, in, 10);
|
||||
if (sexp_exceptionp(exponent)) return exponent;
|
||||
e = (sexp_integerp(exponent) ? sexp_unbox_integer(exponent)
|
||||
: sexp_flonump(exponent) ? sexp_flonum_value(exponent) : 0.0);
|
||||
} else if ((c!=EOF) && ! is_separator(c))
|
||||
return sexp_read_error("invalid numeric syntax",
|
||||
sexp_list1(sexp_make_character(c)), in);
|
||||
return sexp_make_flonum((whole + res) * pow(10, e));
|
||||
return sexp_read_error(ctx, "invalid numeric syntax",
|
||||
sexp_list1(ctx, sexp_make_character(c)), in);
|
||||
return sexp_make_flonum(ctx, (whole + res) * pow(10, e));
|
||||
}
|
||||
|
||||
sexp sexp_read_number(sexp in, int base) {
|
||||
sexp sexp_read_number(sexp ctx, sexp in, int base) {
|
||||
sexp f;
|
||||
sexp_sint_t res = 0, negativep = 0, c;
|
||||
|
||||
|
|
@ -864,10 +862,10 @@ sexp sexp_read_number(sexp in, int base) {
|
|||
|
||||
if (c=='.' || c=='e' || c=='E') {
|
||||
if (base != 10)
|
||||
return sexp_read_error("decimal found in non-base 10", SEXP_NULL, in);
|
||||
return sexp_read_error(ctx, "decimal found in non-base 10", SEXP_NULL, in);
|
||||
if (c!='.')
|
||||
sexp_push_char(c, in);
|
||||
f = sexp_read_float_tail(in, res);
|
||||
f = sexp_read_float_tail(ctx, in, res);
|
||||
if (! sexp_flonump(f)) return f;
|
||||
if ((c!='.') && (sexp_flonum_value(f) == round(sexp_flonum_value(f)))) {
|
||||
res = (sexp_sint_t) sexp_flonum_value(f);
|
||||
|
|
@ -878,14 +876,14 @@ sexp sexp_read_number(sexp in, int base) {
|
|||
} else {
|
||||
sexp_push_char(c, in);
|
||||
if ((c!=EOF) && ! is_separator(c))
|
||||
return sexp_read_error("invalid numeric syntax",
|
||||
sexp_list1(sexp_make_character(c)), in);
|
||||
return sexp_read_error(ctx, "invalid numeric syntax",
|
||||
sexp_list1(ctx, sexp_make_character(c)), in);
|
||||
}
|
||||
|
||||
return sexp_make_integer(negativep ? -res : res);
|
||||
}
|
||||
|
||||
sexp sexp_read_raw (sexp in) {
|
||||
sexp sexp_read_raw (sexp ctx, sexp in) {
|
||||
sexp res, tmp, tmp2;
|
||||
char *str;
|
||||
int c1, c2;
|
||||
|
|
@ -909,82 +907,82 @@ sexp sexp_read_raw (sexp in) {
|
|||
sexp_port_line(in)++;
|
||||
goto scan_loop;
|
||||
case '\'':
|
||||
res = sexp_read(in);
|
||||
res = sexp_list2(the_quote_symbol, res);
|
||||
res = sexp_read(ctx, in);
|
||||
res = sexp_list2(ctx, the_quote_symbol, res);
|
||||
break;
|
||||
case '`':
|
||||
res = sexp_read(in);
|
||||
res = sexp_list2(the_quasiquote_symbol, res);
|
||||
res = sexp_read(ctx, in);
|
||||
res = sexp_list2(ctx, the_quasiquote_symbol, res);
|
||||
break;
|
||||
case ',':
|
||||
if ((c1 = sexp_read_char(in)) == '@') {
|
||||
res = sexp_read(in);
|
||||
res = sexp_list2(the_unquote_splicing_symbol, res);
|
||||
res = sexp_read(ctx, in);
|
||||
res = sexp_list2(ctx, the_unquote_splicing_symbol, res);
|
||||
} else {
|
||||
sexp_push_char(c1, in);
|
||||
res = sexp_read(in);
|
||||
res = sexp_list2(the_unquote_symbol, res);
|
||||
res = sexp_read(ctx, in);
|
||||
res = sexp_list2(ctx, the_unquote_symbol, res);
|
||||
}
|
||||
break;
|
||||
case '"':
|
||||
str = sexp_read_string(in);
|
||||
str = sexp_read_string(ctx, in);
|
||||
if (! str)
|
||||
res = sexp_read_error("premature end of string", SEXP_NULL, in);
|
||||
res = sexp_read_error(ctx, "premature end of string", SEXP_NULL, in);
|
||||
else
|
||||
res = sexp_c_string(str);
|
||||
sexp_free(str);
|
||||
res = sexp_c_string(ctx, str);
|
||||
sexp_free(ctx, str);
|
||||
break;
|
||||
case '(':
|
||||
res = SEXP_NULL;
|
||||
tmp = sexp_read_raw(in);
|
||||
tmp = sexp_read_raw(ctx, in);
|
||||
while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) {
|
||||
if (tmp == SEXP_RAWDOT) {
|
||||
if (res == SEXP_NULL) {
|
||||
return sexp_read_error("dot before any elements in list",
|
||||
return sexp_read_error(ctx, "dot before any elements in list",
|
||||
SEXP_NULL, in);
|
||||
} else {
|
||||
tmp = sexp_read_raw(in);
|
||||
if (sexp_read_raw(in) != SEXP_CLOSE) {
|
||||
sexp_deep_free(res);
|
||||
return sexp_read_error("multiple tokens in dotted tail",
|
||||
tmp = sexp_read_raw(ctx, in);
|
||||
if (sexp_read_raw(ctx, in) != SEXP_CLOSE) {
|
||||
sexp_deep_free(ctx, res);
|
||||
return sexp_read_error(ctx, "multiple tokens in dotted tail",
|
||||
SEXP_NULL, in);
|
||||
} else {
|
||||
tmp2 = res;
|
||||
res = sexp_nreverse(res);
|
||||
res = sexp_nreverse(ctx, res);
|
||||
sexp_cdr(tmp2) = tmp;
|
||||
return res;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
res = sexp_cons(tmp, res);
|
||||
tmp = sexp_read_raw(in);
|
||||
res = sexp_cons(ctx, tmp, res);
|
||||
tmp = sexp_read_raw(ctx, in);
|
||||
}
|
||||
}
|
||||
if (tmp != SEXP_CLOSE) {
|
||||
sexp_deep_free(res);
|
||||
return sexp_read_error("missing trailing ')'", SEXP_NULL, in);
|
||||
sexp_deep_free(ctx, res);
|
||||
return sexp_read_error(ctx, "missing trailing ')'", SEXP_NULL, in);
|
||||
}
|
||||
res = (sexp_pairp(res) ? sexp_nreverse(res) : res);
|
||||
res = (sexp_pairp(res) ? sexp_nreverse(ctx, res) : res);
|
||||
break;
|
||||
case '#':
|
||||
switch (c1=sexp_read_char(in)) {
|
||||
case 'b':
|
||||
res = sexp_read_number(in, 2); break;
|
||||
res = sexp_read_number(ctx, in, 2); break;
|
||||
case 'o':
|
||||
res = sexp_read_number(in, 8); break;
|
||||
res = sexp_read_number(ctx, in, 8); break;
|
||||
case 'd':
|
||||
res = sexp_read_number(in, 10); break;
|
||||
res = sexp_read_number(ctx, in, 10); break;
|
||||
case 'x':
|
||||
res = sexp_read_number(in, 16); break;
|
||||
res = sexp_read_number(ctx, in, 16); break;
|
||||
case 'e':
|
||||
res = sexp_read(in);
|
||||
res = sexp_read(ctx, in);
|
||||
if (sexp_flonump(res))
|
||||
res = sexp_make_integer((sexp_sint_t)sexp_flonum_value(res));
|
||||
break;
|
||||
case 'i':
|
||||
res = sexp_read(in);
|
||||
res = sexp_read(ctx, in);
|
||||
if (sexp_integerp(res))
|
||||
res = sexp_make_flonum(sexp_unbox_integer(res));
|
||||
res = sexp_make_flonum(ctx, sexp_unbox_integer(res));
|
||||
break;
|
||||
case 'f':
|
||||
case 't':
|
||||
|
|
@ -993,21 +991,22 @@ sexp sexp_read_raw (sexp in) {
|
|||
res = (c1 == 't' ? SEXP_TRUE : SEXP_FALSE);
|
||||
sexp_push_char(c2, in);
|
||||
} else {
|
||||
res = sexp_read_error("invalid syntax #%c%c",
|
||||
sexp_list2(sexp_make_character(c1),
|
||||
res = sexp_read_error(ctx, "invalid syntax #%c%c",
|
||||
sexp_list2(ctx,
|
||||
sexp_make_character(c1),
|
||||
sexp_make_character(c2)),
|
||||
in);
|
||||
}
|
||||
break;
|
||||
case ';':
|
||||
sexp_read_raw(in);
|
||||
sexp_read_raw(ctx, in);
|
||||
goto scan_loop;
|
||||
case '\\':
|
||||
c1 = sexp_read_char(in);
|
||||
str = sexp_read_symbol(in, c1);
|
||||
str = sexp_read_symbol(ctx, in, c1);
|
||||
if (str[0] == '\0')
|
||||
res =
|
||||
sexp_read_error("unexpected end of character literal", SEXP_NULL, in);
|
||||
sexp_read_error(ctx, "unexpected end of character literal", SEXP_NULL, in);
|
||||
if (str[1] == '\0') {
|
||||
res = sexp_make_character(c1);
|
||||
} else if ((c1 == 'x' || c1 == 'X') &&
|
||||
|
|
@ -1023,30 +1022,30 @@ sexp sexp_read_raw (sexp in) {
|
|||
else if (strcasecmp(str, "tab") == 0)
|
||||
res = sexp_make_character('\t');
|
||||
else {
|
||||
res = sexp_read_error("unknown character name",
|
||||
sexp_list1(sexp_c_string(str)),
|
||||
res = sexp_read_error(ctx, "unknown character name",
|
||||
sexp_list1(ctx, sexp_c_string(ctx, str)),
|
||||
in);
|
||||
}
|
||||
}
|
||||
sexp_free(str);
|
||||
sexp_free(ctx, str);
|
||||
break;
|
||||
case '(':
|
||||
sexp_push_char(c1, in);
|
||||
res = sexp_read(in);
|
||||
if (sexp_listp(res) == SEXP_FALSE) {
|
||||
res = sexp_read(ctx, in);
|
||||
if (sexp_listp(ctx, res) == SEXP_FALSE) {
|
||||
if (! sexp_exceptionp(res)) {
|
||||
sexp_deep_free(res);
|
||||
res = sexp_read_error("dotted list not allowed in vector syntax",
|
||||
sexp_deep_free(ctx, res);
|
||||
res = sexp_read_error(ctx, "dotted list not allowed in vector syntax",
|
||||
SEXP_NULL,
|
||||
in);
|
||||
}
|
||||
} else {
|
||||
res = sexp_list_to_vector(res);
|
||||
res = sexp_list_to_vector(ctx, res);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
res = sexp_read_error("invalid # syntax",
|
||||
sexp_list1(sexp_make_character(c1)), in);
|
||||
res = sexp_read_error(ctx, "invalid # syntax",
|
||||
sexp_list1(ctx, sexp_make_character(c1)), in);
|
||||
}
|
||||
break;
|
||||
case '.':
|
||||
|
|
@ -1055,12 +1054,12 @@ sexp sexp_read_raw (sexp in) {
|
|||
res = SEXP_RAWDOT;
|
||||
} else if (isdigit(c1)) {
|
||||
sexp_push_char(c1,in );
|
||||
res = sexp_read_float_tail(in, 0);
|
||||
res = sexp_read_float_tail(ctx, in, 0);
|
||||
} else {
|
||||
sexp_push_char(c1, in);
|
||||
str = sexp_read_symbol(in, '.');
|
||||
res = sexp_intern(str);
|
||||
sexp_free(str);
|
||||
str = sexp_read_symbol(ctx, in, '.');
|
||||
res = sexp_intern(ctx, str);
|
||||
sexp_free(ctx, str);
|
||||
}
|
||||
break;
|
||||
case ')':
|
||||
|
|
@ -1071,7 +1070,7 @@ sexp sexp_read_raw (sexp in) {
|
|||
c2 = sexp_read_char(in);
|
||||
if (c2 == '.' || isdigit(c2)) {
|
||||
sexp_push_char(c2, in);
|
||||
res = sexp_read_number(in, 10);
|
||||
res = sexp_read_number(ctx, in, 10);
|
||||
if (sexp_exceptionp(res)) return res;
|
||||
if (c1 == '-') {
|
||||
#ifdef USE_FLONUMS
|
||||
|
|
@ -1083,47 +1082,48 @@ sexp sexp_read_raw (sexp in) {
|
|||
}
|
||||
} else {
|
||||
sexp_push_char(c2, in);
|
||||
str = sexp_read_symbol(in, c1);
|
||||
res = sexp_intern(str);
|
||||
sexp_free(str);
|
||||
str = sexp_read_symbol(ctx, in, c1);
|
||||
res = sexp_intern(ctx, str);
|
||||
sexp_free(ctx, str);
|
||||
}
|
||||
break;
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
sexp_push_char(c1, in);
|
||||
res = sexp_read_number(in, 10);
|
||||
res = sexp_read_number(ctx, in, 10);
|
||||
break;
|
||||
default:
|
||||
str = sexp_read_symbol(in, c1);
|
||||
res = sexp_intern(str);
|
||||
sexp_free(str);
|
||||
str = sexp_read_symbol(ctx, in, c1);
|
||||
res = sexp_intern(ctx, str);
|
||||
sexp_free(ctx, str);
|
||||
break;
|
||||
}
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp sexp_read (sexp in) {
|
||||
sexp res = sexp_read_raw(in);
|
||||
sexp sexp_read (sexp ctx, sexp in) {
|
||||
sexp res = sexp_read_raw(ctx, in);
|
||||
if (res == SEXP_CLOSE)
|
||||
return sexp_read_error("too many ')'s", SEXP_NULL, in);
|
||||
return sexp_read_error(ctx, "too many ')'s", SEXP_NULL, in);
|
||||
if (res == SEXP_RAWDOT)
|
||||
return sexp_read_error("unexpected '.'", SEXP_NULL, in);
|
||||
return sexp_read_error(ctx, "unexpected '.'", SEXP_NULL, in);
|
||||
return res;
|
||||
}
|
||||
|
||||
#if USE_STRING_STREAMS
|
||||
sexp sexp_read_from_string(char *str) {
|
||||
sexp s = sexp_c_string(str);
|
||||
sexp in = sexp_make_input_string_port(s);
|
||||
sexp res = sexp_read(in);
|
||||
sexp_deep_free(s);
|
||||
sexp_deep_free(in);
|
||||
sexp sexp_read_from_string(sexp ctx, char *str) {
|
||||
sexp s = sexp_c_string(ctx, str);
|
||||
sexp in = sexp_make_input_string_port(ctx, s);
|
||||
sexp res = sexp_read(ctx, in);
|
||||
sexp_free(ctx, s);
|
||||
sexp_deep_free(ctx, in);
|
||||
return res;
|
||||
}
|
||||
#endif
|
||||
|
||||
void sexp_init() {
|
||||
int i;
|
||||
sexp ctx;
|
||||
if (! sexp_initialized_p) {
|
||||
sexp_initialized_p = 1;
|
||||
#if USE_BOEHM
|
||||
|
|
@ -1133,13 +1133,14 @@ void sexp_init() {
|
|||
#endif
|
||||
for (i=0; i<SEXP_SYMBOL_TABLE_SIZE; i++)
|
||||
symbol_table[i] = SEXP_NULL;
|
||||
the_dot_symbol = sexp_intern(".");
|
||||
the_quote_symbol = sexp_intern("quote");
|
||||
the_quasiquote_symbol = sexp_intern("quasiquote");
|
||||
the_unquote_symbol = sexp_intern("unquote");
|
||||
the_unquote_splicing_symbol = sexp_intern("unquote-splicing");
|
||||
the_read_error_symbol = sexp_intern("read");
|
||||
the_empty_vector = sexp_alloc_type(vector, SEXP_VECTOR);
|
||||
ctx = sexp_alloc_type(NULL, context, SEXP_CONTEXT);
|
||||
the_dot_symbol = sexp_intern(ctx, ".");
|
||||
the_quote_symbol = sexp_intern(ctx, "quote");
|
||||
the_quasiquote_symbol = sexp_intern(ctx, "quasiquote");
|
||||
the_unquote_symbol = sexp_intern(ctx, "unquote");
|
||||
the_unquote_splicing_symbol = sexp_intern(ctx, "unquote-splicing");
|
||||
the_read_error_symbol = sexp_intern(ctx, "read");
|
||||
the_empty_vector = sexp_alloc_type(ctx, vector, SEXP_VECTOR);
|
||||
sexp_vector_length(the_empty_vector) = 0;
|
||||
sexp_vector_data(the_empty_vector) = NULL;
|
||||
}
|
||||
|
|
|
|||
98
sexp.h
98
sexp.h
|
|
@ -82,7 +82,7 @@ typedef struct sexp_struct *sexp;
|
|||
struct sexp_struct {
|
||||
sexp_tag_t tag;
|
||||
char immutablep;
|
||||
char mark;
|
||||
char gc_mark;
|
||||
union {
|
||||
/* basic types */
|
||||
double flonum;
|
||||
|
|
@ -171,7 +171,7 @@ struct sexp_struct {
|
|||
#define sexp_sizeof(x) (offsetof(struct sexp_struct, value) \
|
||||
+ sizeof(((sexp)0)->value.x))
|
||||
|
||||
#define sexp_alloc_type(type, tag) sexp_alloc_tagged(sexp_sizeof(type), tag)
|
||||
#define sexp_alloc_type(ctx, type, tag) sexp_alloc_tagged(ctx, sexp_sizeof(type), tag)
|
||||
|
||||
#define SEXP_MAKE_IMMEDIATE(n) ((sexp) ((n<<SEXP_EXTENDED_BITS) \
|
||||
+ SEXP_EXTENDED_TAG))
|
||||
|
|
@ -236,9 +236,9 @@ struct sexp_struct {
|
|||
#define sexp_flonum_value(f) ((f)->value.flonum)
|
||||
|
||||
#if USE_FLONUMS
|
||||
#define sexp_integer_to_flonum(x) (sexp_make_flonum(sexp_unbox_integer(x)))
|
||||
#define sexp_integer_to_flonum(ctx, x) (sexp_make_flonum(ctx, sexp_unbox_integer(x)))
|
||||
#else
|
||||
#define sexp_integer_to_flonum(x) (x)
|
||||
#define sexp_integer_to_flonum(ctx, x) (x)
|
||||
#endif
|
||||
|
||||
/*************************** field accessors **************************/
|
||||
|
|
@ -357,20 +357,20 @@ struct sexp_struct {
|
|||
#define sexp_fx_rem(a, b) (sexp_make_integer(sexp_unbox_integer(a) % sexp_unbox_integer(b)))
|
||||
#define sexp_fx_sign(a) (-((sexp_sint_t)(a) < 0)) /* -1 or 0 */
|
||||
|
||||
#define sexp_fp_add(a, b) (sexp_make_flonum(sexp_flonum_value(a) + sexp_flonum_value(b)))
|
||||
#define sexp_fp_sub(a, b) (sexp_make_flonum(sexp_flonum_value(a) - sexp_flonum_value(b)))
|
||||
#define sexp_fp_mul(a, b) (sexp_make_flonum(sexp_flonum_value(a) * sexp_flonum_value(b)))
|
||||
#define sexp_fp_div(a, b) (sexp_make_flonum(sexp_flonum_value(a) / sexp_flonum_value(b)))
|
||||
#define sexp_fp_add(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) + sexp_flonum_value(b)))
|
||||
#define sexp_fp_sub(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) - sexp_flonum_value(b)))
|
||||
#define sexp_fp_mul(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) * sexp_flonum_value(b)))
|
||||
#define sexp_fp_div(x,a,b) (sexp_make_flonum(x, sexp_flonum_value(a) / sexp_flonum_value(b)))
|
||||
|
||||
/****************************** utilities *****************************/
|
||||
|
||||
#define sexp_list1(a) sexp_cons(a, SEXP_NULL)
|
||||
#define sexp_list2(a, b) sexp_cons(a, sexp_cons(b, SEXP_NULL))
|
||||
#define sexp_list3(a, b, c) sexp_cons(a, sexp_cons(b, sexp_cons(c, SEXP_NULL)))
|
||||
#define sexp_list4(a, b, c, d) sexp_cons(a, sexp_cons(b, sexp_cons(c, sexp_cons(d, SEXP_NULL))))
|
||||
#define sexp_list1(x,a) sexp_cons((x), (a), SEXP_NULL)
|
||||
#define sexp_list2(x,a,b) sexp_cons((x), (a), sexp_cons((x), (b), SEXP_NULL))
|
||||
#define sexp_list3(x,a,b,c) sexp_cons((x), (a), sexp_cons((x), (b), sexp_cons((x), (c), SEXP_NULL)))
|
||||
#define sexp_list4(x,a,b,c,d) sexp_cons((x), (a), sexp_cons((x), (b), sexp_cons((x), (c), sexp_cons((x), (d), SEXP_NULL))))
|
||||
|
||||
#define sexp_push(ls, x) ((ls) = sexp_cons((x), (ls)))
|
||||
#define sexp_insert(ls, x) ((sexp_memq((x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ls), (x)))
|
||||
#define sexp_push(ctx, ls, x) ((ls) = sexp_cons((ctx), (x), (ls)))
|
||||
#define sexp_insert(ctx, ls, x) ((sexp_memq(NULL, (x), (ls)) != SEXP_FALSE) ? (ls) : sexp_push((ctx), (ls), (x)))
|
||||
|
||||
#define sexp_car(x) ((x)->value.pair.car)
|
||||
#define sexp_cdr(x) ((x)->value.pair.cdr)
|
||||
|
|
@ -400,43 +400,43 @@ struct sexp_struct {
|
|||
#define sexp_scanf(p, ...) (fscanf(sexp_port_stream(p), __VA_ARGS__))
|
||||
#define sexp_flush(p) (fflush(sexp_port_stream(p)))
|
||||
|
||||
sexp sexp_alloc_tagged(size_t size, sexp_uint_t tag);
|
||||
sexp sexp_cons(sexp head, sexp tail);
|
||||
sexp sexp_equalp (sexp a, sexp b);
|
||||
sexp sexp_listp(sexp obj);
|
||||
sexp sexp_reverse(sexp ls);
|
||||
sexp sexp_nreverse(sexp ls);
|
||||
sexp sexp_append(sexp a, sexp b);
|
||||
sexp sexp_memq(sexp x, sexp ls);
|
||||
sexp sexp_assq(sexp x, sexp ls);
|
||||
sexp sexp_length(sexp ls);
|
||||
sexp sexp_c_string(char *str);
|
||||
sexp sexp_make_string(sexp len, sexp ch);
|
||||
sexp sexp_substring (sexp str, sexp start, sexp end);
|
||||
sexp sexp_make_flonum(double f);
|
||||
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
|
||||
sexp sexp_cons(sexp ctx, sexp head, sexp tail);
|
||||
sexp sexp_equalp (sexp ctx, sexp a, sexp b);
|
||||
sexp sexp_listp(sexp ctx, sexp obj);
|
||||
sexp sexp_reverse(sexp ctx, sexp ls);
|
||||
sexp sexp_nreverse(sexp ctx, sexp ls);
|
||||
sexp sexp_append2(sexp ctx, sexp a, sexp b);
|
||||
sexp sexp_memq(sexp ctx, sexp x, sexp ls);
|
||||
sexp sexp_assq(sexp ctx, sexp x, sexp ls);
|
||||
sexp sexp_length(sexp ctx, sexp ls);
|
||||
sexp sexp_c_string(sexp ctx, char *str);
|
||||
sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
|
||||
sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
|
||||
sexp sexp_make_flonum(sexp ctx, double f);
|
||||
sexp_uint_t sexp_string_hash(char *str, sexp_uint_t acc);
|
||||
sexp sexp_intern(char *str);
|
||||
sexp sexp_string_to_symbol(sexp str);
|
||||
sexp sexp_make_vector(sexp len, sexp dflt);
|
||||
sexp sexp_list_to_vector(sexp ls);
|
||||
sexp sexp_vector(int count, ...);
|
||||
sexp sexp_intern(sexp ctx, char *str);
|
||||
sexp sexp_string_to_symbol(sexp ctx, sexp str);
|
||||
sexp sexp_make_vector(sexp ctx, sexp len, sexp dflt);
|
||||
sexp sexp_list_to_vector(sexp ctx, sexp ls);
|
||||
sexp sexp_vector(sexp ctx, int count, ...);
|
||||
void sexp_write(sexp obj, sexp out);
|
||||
char* sexp_read_string(sexp in);
|
||||
char* sexp_read_symbol(sexp in, int init);
|
||||
sexp sexp_read_number(sexp in, int base);
|
||||
sexp sexp_read_raw(sexp in);
|
||||
sexp sexp_read(sexp in);
|
||||
sexp sexp_read_from_string(char *str);
|
||||
sexp sexp_make_input_port(FILE* in, char *path);
|
||||
sexp sexp_make_output_port(FILE* out, char *path);
|
||||
sexp sexp_make_input_string_port(sexp str);
|
||||
sexp sexp_make_output_string_port();
|
||||
sexp sexp_get_output_string(sexp port);
|
||||
sexp sexp_make_exception(sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
|
||||
sexp sexp_user_exception (sexp self, char *message, sexp obj);
|
||||
sexp sexp_type_exception (char *message, sexp obj);
|
||||
sexp sexp_range_exception (sexp obj, sexp start, sexp end);
|
||||
sexp sexp_print_exception(sexp exn, sexp out);
|
||||
char* sexp_read_string(sexp ctx, sexp in);
|
||||
char* sexp_read_symbol(sexp ctx, sexp in, int init);
|
||||
sexp sexp_read_number(sexp ctx, sexp in, int base);
|
||||
sexp sexp_read_raw(sexp ctx, sexp in);
|
||||
sexp sexp_read(sexp ctx, sexp in);
|
||||
sexp sexp_read_from_string(sexp ctx, char *str);
|
||||
sexp sexp_make_input_port(sexp ctx, FILE* in, char *path);
|
||||
sexp sexp_make_output_port(sexp ctx, FILE* out, char *path);
|
||||
sexp sexp_make_input_string_port(sexp ctx, sexp str);
|
||||
sexp sexp_make_output_string_port(sexp ctx);
|
||||
sexp sexp_get_output_string(sexp ctx, sexp port);
|
||||
sexp sexp_make_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
|
||||
sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj);
|
||||
sexp sexp_type_exception (sexp ctx, char *message, sexp obj);
|
||||
sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);
|
||||
sexp sexp_print_exception(sexp ctx, sexp exn, sexp out);
|
||||
void sexp_init();
|
||||
|
||||
#endif /* ! SEXP_H */
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue