mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-09 22:17:34 +02:00
cleaning up error handling, support flonum arith
This commit is contained in:
Alex Shinn
parent
92aed1eda8
commit
3a8f46027c
6 changed files with 417 additions and 394 deletions
2
Makefile
2
Makefile
|
|
@ -23,7 +23,7 @@ chibi-scheme: eval.o sexp.o $(GC_OBJ)
|
|||
gcc $(CFLAGS) -o $@ $^
|
||||
|
||||
clean:
|
||||
rm -f *.o
|
||||
rm -f *.o *.i *.s
|
||||
|
||||
cleaner: clean
|
||||
rm -f chibi-scheme
|
||||
|
|
|
|||
29
config.h
29
config.h
|
|
@ -2,22 +2,21 @@
|
|||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#ifndef USE_BOEHM
|
||||
#define USE_BOEHM 1
|
||||
#endif
|
||||
/* uncomment this to use manual memory management */
|
||||
/* #define USE_BOEHM 0 */
|
||||
|
||||
#ifndef USE_HUFF_SYMS
|
||||
#define USE_HUFF_SYMS 1
|
||||
#endif
|
||||
/* uncomment this if you only want fixnum support */
|
||||
/* #define USE_FLONUMS 0 */
|
||||
|
||||
#ifndef USE_DEBUG
|
||||
#define USE_DEBUG 1
|
||||
#endif
|
||||
/* uncomment this to disable huffman-coded immediate symbols */
|
||||
/* #define USE_HUFF_SYMS 0 */
|
||||
|
||||
#ifndef USE_STRING_STREAMS
|
||||
#define USE_STRING_STREAMS 1
|
||||
#endif
|
||||
/* uncomment this to disable string ports */
|
||||
/* #define USE_STRING_STREAMS 0 */
|
||||
|
||||
/* uncomment this to disable a small optimization for let */
|
||||
/* #define USE_FAST_LET 0 */
|
||||
|
||||
/* uncomment this to enable debugging utilities */
|
||||
/* #define USE_DEBUG 1 */
|
||||
|
||||
#ifndef USE_FAST_LET
|
||||
#define USE_FAST_LET 1
|
||||
#endif
|
||||
|
|
|
|||
24
eval.h
24
eval.h
|
|
@ -129,16 +129,20 @@ enum opcode_names {
|
|||
|
||||
sexp compile(sexp params, sexp obj, sexp e, sexp fv, sexp sv, int done_p);
|
||||
|
||||
void analyze_app (sexp obj, sexp *bc, sexp_uint_t *i,
|
||||
sexp e, sexp params, sexp fv, sexp sv,
|
||||
sexp_uint_t *d, int tailp);
|
||||
void analyze_lambda (sexp name, sexp formals, sexp body,
|
||||
sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
void analyze_var_ref (sexp name, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d);
|
||||
void analyze_opcode (sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
sexp analyze_app(sexp obj, sexp *bc, sexp_uint_t *i,
|
||||
sexp e, sexp params, sexp fv, sexp sv,
|
||||
sexp_uint_t *d, int tailp);
|
||||
sexp analyze_lambda(sexp name, sexp formals, sexp body,
|
||||
sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
void analyze_var_ref(sexp name, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d);
|
||||
sexp analyze_opcode(sexp op, sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
sexp analyze(sexp obj, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
sexp analyze_sequence(sexp ls, sexp *bc, sexp_uint_t *i, sexp e,
|
||||
sexp params, sexp fv, sexp sv, sexp_uint_t *d, int tailp);
|
||||
sexp vm(sexp bc, sexp e, sexp* stack, sexp_sint_t top);
|
||||
|
||||
sexp eval_in_stack(sexp expr, sexp e, sexp* stack, sexp_sint_t top);
|
||||
|
|
|
|||
127
sexp.c
127
sexp.c
|
|
@ -23,6 +23,7 @@ static sexp the_quote_symbol;
|
|||
static sexp the_quasiquote_symbol;
|
||||
static sexp the_unquote_symbol;
|
||||
static sexp the_unquote_splicing_symbol;
|
||||
static sexp the_read_error_symbol;
|
||||
static sexp the_empty_vector;
|
||||
|
||||
static char sexp_separators[] = {
|
||||
|
|
@ -76,6 +77,48 @@ void sexp_free (sexp obj) {
|
|||
}
|
||||
}
|
||||
|
||||
/***************************** exceptions *****************************/
|
||||
|
||||
sexp sexp_make_exception(sexp kind, sexp message, sexp irritants,
|
||||
sexp file, sexp line) {
|
||||
sexp exn = SEXP_ALLOC(sexp_sizeof(exception));
|
||||
exn->tag = SEXP_EXCEPTION;
|
||||
sexp_exception_kind(exn) = kind;
|
||||
sexp_exception_message(exn) = message;
|
||||
sexp_exception_irritants(exn) = irritants;
|
||||
sexp_exception_file(exn) = file;
|
||||
sexp_exception_line(exn) = line;
|
||||
return exn;
|
||||
}
|
||||
|
||||
sexp sexp_print_exception(sexp exn, sexp out) {
|
||||
sexp_write_string("error", out);
|
||||
if (sexp_exception_line(exn) > sexp_make_integer(0)) {
|
||||
sexp_write_string(" on line ", out);
|
||||
sexp_write(sexp_exception_line(exn), out);
|
||||
}
|
||||
if (sexp_stringp(sexp_exception_file(exn))) {
|
||||
sexp_write_string(" of file ", out);
|
||||
sexp_write_string(sexp_string_data(sexp_exception_file(exn)), out);
|
||||
}
|
||||
sexp_write_string(": ", out);
|
||||
sexp_write_string(sexp_string_data(sexp_exception_message(exn)), out);
|
||||
sexp_write_string("\n", out);
|
||||
if (sexp_pairp(sexp_exception_irritants(exn))) {
|
||||
sexp_write_string(" irritants: ", out);
|
||||
sexp_write(sexp_exception_irritants(exn), out);
|
||||
sexp_write_string("\n", out);
|
||||
}
|
||||
return SEXP_UNDEF;
|
||||
}
|
||||
|
||||
static sexp sexp_read_error(char *message, sexp irritants, sexp port) {
|
||||
return sexp_make_exception(the_read_error_symbol, sexp_make_string(message),
|
||||
irritants,
|
||||
sexp_make_string(sexp_port_name(port)),
|
||||
sexp_make_integer(sexp_port_line(port)));
|
||||
}
|
||||
|
||||
/*************************** list utilities ***************************/
|
||||
|
||||
sexp sexp_cons(sexp head, sexp tail) {
|
||||
|
|
@ -325,20 +368,6 @@ int sstream_close(void *vec) {
|
|||
return 0;
|
||||
}
|
||||
|
||||
sexp sexp_make_input_port(FILE* in) {
|
||||
sexp p = SEXP_ALLOC(sexp_sizeof(port));
|
||||
p->tag = SEXP_IPORT;
|
||||
sexp_port_stream(p) = in;
|
||||
return p;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_port(FILE* out) {
|
||||
sexp p = SEXP_ALLOC(sexp_sizeof(port));
|
||||
p->tag = SEXP_OPORT;
|
||||
sexp_port_stream(p) = out;
|
||||
return p;
|
||||
}
|
||||
|
||||
sexp sexp_make_input_string_port(sexp str) {
|
||||
FILE *in = fmemopen(sexp_string_data(str), sexp_string_length(str), "r");
|
||||
return sexp_make_input_port(in);
|
||||
|
|
@ -354,6 +383,22 @@ sexp sexp_get_output_string(sexp port) {
|
|||
|
||||
#endif
|
||||
|
||||
sexp sexp_make_input_port(FILE* in) {
|
||||
sexp p = SEXP_ALLOC(sexp_sizeof(port));
|
||||
p->tag = SEXP_IPORT;
|
||||
sexp_port_stream(p) = in;
|
||||
sexp_port_line(p) = 0;
|
||||
return p;
|
||||
}
|
||||
|
||||
sexp sexp_make_output_port(FILE* out) {
|
||||
sexp p = SEXP_ALLOC(sexp_sizeof(port));
|
||||
p->tag = SEXP_OPORT;
|
||||
sexp_port_stream(p) = out;
|
||||
sexp_port_line(p) = 0;
|
||||
return p;
|
||||
}
|
||||
|
||||
void sexp_write (sexp obj, sexp out) {
|
||||
unsigned long len, c, res;
|
||||
long i=0;
|
||||
|
|
@ -408,6 +453,8 @@ void sexp_write (sexp obj, sexp out) {
|
|||
sexp_write_string("#<bytecode>", out); break;
|
||||
case SEXP_ENV:
|
||||
sexp_write_string("#<env>", out); break;
|
||||
case SEXP_EXCEPTION:
|
||||
sexp_write_string("#<exception>", out); break;
|
||||
case SEXP_MACRO:
|
||||
sexp_write_string("#<macro>", out); break;
|
||||
case SEXP_STRING:
|
||||
|
|
@ -550,10 +597,10 @@ sexp sexp_read_number(sexp in, int base) {
|
|||
res = res * base + digit_value(c);
|
||||
if (c=='.') {
|
||||
if (base != 10) {
|
||||
fprintf(stderr, "decimal found in non-base 10");
|
||||
return SEXP_ERROR;
|
||||
return sexp_read_error("decimal found in non-base 10", SEXP_NULL, in);
|
||||
}
|
||||
tmp = sexp_read_float_tail(in, res);
|
||||
if (sexp_exceptionp(tmp)) return tmp;
|
||||
if (negativep && sexp_flonump(tmp))
|
||||
sexp_flonum_value(tmp) = -1 * sexp_flonum_value(tmp);
|
||||
return tmp;
|
||||
|
|
@ -575,6 +622,7 @@ sexp sexp_read_raw (sexp in) {
|
|||
res = SEXP_EOF;
|
||||
break;
|
||||
case ';':
|
||||
sexp_port_line(in)++;
|
||||
while ((c1 = sexp_read_char(in)) != EOF)
|
||||
if (c1 == '\n')
|
||||
break;
|
||||
|
|
@ -582,7 +630,9 @@ sexp sexp_read_raw (sexp in) {
|
|||
case ' ':
|
||||
case '\t':
|
||||
case '\r':
|
||||
goto scan_loop;
|
||||
case '\n':
|
||||
sexp_port_line(in)++;
|
||||
goto scan_loop;
|
||||
case '\'':
|
||||
res = sexp_read(in);
|
||||
|
|
@ -613,14 +663,14 @@ sexp sexp_read_raw (sexp in) {
|
|||
while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) {
|
||||
if (tmp == SEXP_RAWDOT) {
|
||||
if (res == SEXP_NULL) {
|
||||
fprintf(stderr, "sexp: dot before any elements in list\n");
|
||||
return SEXP_ERROR;
|
||||
return sexp_read_error("dot before any elements in list",
|
||||
SEXP_NULL, in);
|
||||
} else {
|
||||
tmp = sexp_read_raw(in);
|
||||
if (sexp_read_raw(in) != SEXP_CLOSE) {
|
||||
fprintf(stderr, "sexp: multiple tokens in dotted tail\n");
|
||||
sexp_free(res);
|
||||
return SEXP_ERROR;
|
||||
return sexp_read_error("multiple tokens in dotted tail",
|
||||
SEXP_NULL, in);
|
||||
} else {
|
||||
tmp2 = res;
|
||||
res = sexp_nreverse(res);
|
||||
|
|
@ -635,9 +685,9 @@ sexp sexp_read_raw (sexp in) {
|
|||
}
|
||||
if (tmp != SEXP_CLOSE) {
|
||||
sexp_free(res);
|
||||
res = SEXP_ERROR;
|
||||
return sexp_read_error("missing trailing ')'", SEXP_NULL, in);
|
||||
}
|
||||
res = sexp_nreverse(res);
|
||||
res = (sexp_pairp(res) ? sexp_nreverse(res) : res);
|
||||
break;
|
||||
case '#':
|
||||
switch (c1=sexp_read_char(in)) {
|
||||
|
|
@ -657,8 +707,10 @@ sexp sexp_read_raw (sexp in) {
|
|||
if (c2 == EOF || is_separator(c2)) {
|
||||
res = (c1 == 't' ? SEXP_TRUE : SEXP_FALSE);
|
||||
} else {
|
||||
fprintf(stderr, "sexp: invalid syntax #%c%c\n", c1, c2);
|
||||
res = SEXP_ERROR;
|
||||
return sexp_read_error("invalid syntax #%c%c",
|
||||
sexp_list2(sexp_make_character(c1),
|
||||
sexp_make_character(c2)),
|
||||
in);
|
||||
}
|
||||
sexp_push_char(c2, in);
|
||||
break;
|
||||
|
|
@ -685,8 +737,9 @@ sexp sexp_read_raw (sexp in) {
|
|||
else if (strcasecmp(str, "tab") == 0)
|
||||
res = sexp_make_character('\t');
|
||||
else {
|
||||
fprintf(stderr, "unknown character name: '%s'\n", str);
|
||||
res = SEXP_ERROR;
|
||||
return sexp_read_error("unknown character name",
|
||||
sexp_list1(sexp_make_string(str)),
|
||||
in);
|
||||
}
|
||||
}
|
||||
break;
|
||||
|
|
@ -694,19 +747,19 @@ sexp sexp_read_raw (sexp in) {
|
|||
sexp_push_char(c1, in);
|
||||
res = sexp_read(in);
|
||||
if (! sexp_listp(res)) {
|
||||
if (res != SEXP_ERROR) {
|
||||
fprintf(stderr, "sexp: dotted list not allowed in vector syntax\n");
|
||||
if (! sexp_exceptionp(res)) {
|
||||
sexp_free(res);
|
||||
res = SEXP_ERROR;
|
||||
return sexp_read_error("dotted list not allowed in vector syntax",
|
||||
SEXP_NULL,
|
||||
in);
|
||||
}
|
||||
} else {
|
||||
res = sexp_list_to_vector(res);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
fprintf(stderr, "sexp: invalid syntax #%c\n", c1);
|
||||
res = SEXP_ERROR;
|
||||
break;
|
||||
return sexp_read_error("invalid # syntax",
|
||||
sexp_list1(sexp_make_character(c1)), in);
|
||||
}
|
||||
break;
|
||||
case '.':
|
||||
|
|
@ -732,7 +785,8 @@ sexp sexp_read_raw (sexp in) {
|
|||
if (c2 == '.' || isdigit(c2)) {
|
||||
sexp_push_char(c2, in);
|
||||
res = sexp_read_number(in, 10);
|
||||
if (c1 == '-') res = sexp_mul(res, -1);
|
||||
if (sexp_exceptionp(res)) return res;
|
||||
if (c1 == '-') res = sexp_fx_mul(res, -1);
|
||||
} else {
|
||||
sexp_push_char(c2, in);
|
||||
str = sexp_read_symbol(in, c1);
|
||||
|
|
@ -756,8 +810,10 @@ sexp sexp_read_raw (sexp in) {
|
|||
|
||||
sexp sexp_read (sexp in) {
|
||||
sexp res = sexp_read_raw(in);
|
||||
if ((res == SEXP_CLOSE) || (res == SEXP_RAWDOT))
|
||||
res = SEXP_ERROR;
|
||||
if (res == SEXP_CLOSE)
|
||||
return sexp_read_error("too many ')'s", SEXP_NULL, in);
|
||||
if (res == SEXP_RAWDOT)
|
||||
return sexp_read_error("unexpected '.'", SEXP_NULL, in);
|
||||
return res;
|
||||
}
|
||||
|
||||
|
|
@ -782,6 +838,7 @@ void sexp_init() {
|
|||
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-error");
|
||||
the_empty_vector = SEXP_ALLOC(sexp_sizeof(vector));
|
||||
the_empty_vector->tag = SEXP_VECTOR;
|
||||
sexp_vector_length(the_empty_vector) = 0;
|
||||
|
|
|
|||
92
sexp.h
92
sexp.h
|
|
@ -12,34 +12,7 @@
|
|||
#include <stdarg.h>
|
||||
|
||||
#include "config.h"
|
||||
|
||||
#if HAVE_ERR_H
|
||||
#include <err.h>
|
||||
#else
|
||||
/* requires msg be a string literal, and at least one argument */
|
||||
#define errx(code, msg, ...) (fprintf(stderr,msg"\n",__VA_ARGS__), exit(code))
|
||||
#endif
|
||||
|
||||
#if defined(__APPLE__) || defined(__FreeBSD__) || defined(__NetBSD__) || defined(__DragonFly__) || defined(__OpenBSD__)
|
||||
#define SEXP_BSD 1
|
||||
#else
|
||||
#define SEXP_BSD 0
|
||||
#endif
|
||||
|
||||
#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 GC_free
|
||||
#else
|
||||
#define SEXP_ALLOC malloc
|
||||
#define SEXP_ALLOC_ATOMIC SEXP_ALLOC
|
||||
#define SEXP_REALLOC realloc
|
||||
#define SEXP_FREE free
|
||||
#endif
|
||||
|
||||
#define SEXP_NEW() ((sexp) SEXP_ALLOC(sizeof(struct sexp_struct)))
|
||||
#include "defaults.h"
|
||||
|
||||
/* tagging system
|
||||
* bits end in 00: pointer
|
||||
|
|
@ -60,7 +33,6 @@
|
|||
|
||||
#define SEXP_POINTER_TAG 0
|
||||
#define SEXP_FIXNUM_TAG 1
|
||||
#define SEXP_LSYMBOL_TAG 3
|
||||
#define SEXP_ISYMBOL_TAG 7
|
||||
#define SEXP_CHAR_TAG 6
|
||||
#define SEXP_EXTENDED_TAG 14
|
||||
|
|
@ -78,8 +50,8 @@ enum sexp_types {
|
|||
SEXP_BIGNUM,
|
||||
SEXP_IPORT,
|
||||
SEXP_OPORT,
|
||||
/* the following are used only by the evaluator */
|
||||
SEXP_EXCEPTION,
|
||||
/* the following are used only by the evaluator */
|
||||
SEXP_PROCEDURE,
|
||||
SEXP_MACRO,
|
||||
SEXP_ENV,
|
||||
|
|
@ -158,7 +130,7 @@ struct sexp_struct {
|
|||
#define SEXP_TRUE SEXP_MAKE_IMMEDIATE(2)
|
||||
#define SEXP_EOF SEXP_MAKE_IMMEDIATE(3)
|
||||
#define SEXP_UNDEF SEXP_MAKE_IMMEDIATE(4)
|
||||
#define SEXP_ERROR SEXP_MAKE_IMMEDIATE(5)
|
||||
#define SEXP_ERROR SEXP_MAKE_IMMEDIATE(5) /* exceptions are preferred */
|
||||
#define SEXP_CLOSE SEXP_MAKE_IMMEDIATE(6) /* internal use */
|
||||
#define SEXP_RAWDOT SEXP_MAKE_IMMEDIATE(7) /* internal use */
|
||||
|
||||
|
|
@ -171,36 +143,35 @@ struct sexp_struct {
|
|||
|
||||
#define SEXP_CHECK_TAG(x,t) (sexp_pointerp(x) && (x)->tag == (t))
|
||||
|
||||
#define sexp_pairp(x) (SEXP_CHECK_TAG(x, SEXP_PAIR))
|
||||
#define sexp_stringp(x) (SEXP_CHECK_TAG(x, SEXP_STRING))
|
||||
#define sexp_lsymbolp(x) (SEXP_CHECK_TAG(x, SEXP_SYMBOL))
|
||||
#define sexp_vectorp(x) (SEXP_CHECK_TAG(x, SEXP_VECTOR))
|
||||
#define sexp_flonump(x) (SEXP_CHECK_TAG(x, SEXP_FLONUM))
|
||||
#define sexp_iportp(x) (SEXP_CHECK_TAG(x, SEXP_IPORT))
|
||||
#define sexp_oportp(x) (SEXP_CHECK_TAG(x, SEXP_OPORT))
|
||||
#define sexp_exceptionp(x) (SEXP_CHECK_TAG(x, SEXP_EXCEPTION))
|
||||
#define sexp_procedurep(x) (SEXP_CHECK_TAG(x, SEXP_PROCEDURE))
|
||||
#define sexp_envp(x) (SEXP_CHECK_TAG(x, SEXP_ENV))
|
||||
#define sexp_bytecodep(x) (SEXP_CHECK_TAG(x, SEXP_BYTECODE))
|
||||
#define sexp_corep(x) (SEXP_CHECK_TAG(x, SEXP_CORE))
|
||||
#define sexp_opcodep(x) (SEXP_CHECK_TAG(x, SEXP_OPCODE))
|
||||
#define sexp_macrop(x) (SEXP_CHECK_TAG(x, SEXP_MACRO))
|
||||
#define sexp_pairp(x) (SEXP_CHECK_TAG(x, SEXP_PAIR))
|
||||
#define sexp_stringp(x) (SEXP_CHECK_TAG(x, SEXP_STRING))
|
||||
#define sexp_lsymbolp(x) (SEXP_CHECK_TAG(x, SEXP_SYMBOL))
|
||||
#define sexp_vectorp(x) (SEXP_CHECK_TAG(x, SEXP_VECTOR))
|
||||
#define sexp_flonump(x) (SEXP_CHECK_TAG(x, SEXP_FLONUM))
|
||||
#define sexp_iportp(x) (SEXP_CHECK_TAG(x, SEXP_IPORT))
|
||||
#define sexp_oportp(x) (SEXP_CHECK_TAG(x, SEXP_OPORT))
|
||||
#define sexp_exceptionp(x) (SEXP_CHECK_TAG(x, SEXP_EXCEPTION))
|
||||
#define sexp_procedurep(x) (SEXP_CHECK_TAG(x, SEXP_PROCEDURE))
|
||||
#define sexp_envp(x) (SEXP_CHECK_TAG(x, SEXP_ENV))
|
||||
#define sexp_bytecodep(x) (SEXP_CHECK_TAG(x, SEXP_BYTECODE))
|
||||
#define sexp_corep(x) (SEXP_CHECK_TAG(x, SEXP_CORE))
|
||||
#define sexp_opcodep(x) (SEXP_CHECK_TAG(x, SEXP_OPCODE))
|
||||
#define sexp_macrop(x) (SEXP_CHECK_TAG(x, SEXP_MACRO))
|
||||
#define sexp_symbolp(x) (sexp_isymbolp(x) || sexp_lsymbolp(x))
|
||||
|
||||
#define sexp_symbolp(x) (sexp_isymbolp(x) || sexp_lsymbolp(x))
|
||||
|
||||
#if USE_HUFF_SYMS
|
||||
#define SEXP_DOTP(x) (((sexp_uint_t)(x))==((0x5D00<<SEXP_IMMEDIATE_BITS)+SEXP_ISYMBOL_TAG))
|
||||
#else
|
||||
#define SEXP_DOTP(x) ((x)==sexp_the_dot_symbol)
|
||||
#endif
|
||||
#define sexp_make_boolean(x) ((x) ? SEXP_TRUE : SEXP_FALSE)
|
||||
#define sexp_unbox_boolean(x) (((x) == SEXP_FALSE) ? 0 : 1)
|
||||
|
||||
#define sexp_make_integer(n) ((sexp) ((((sexp_sint_t)n)<<SEXP_FIXNUM_BITS) + SEXP_FIXNUM_TAG))
|
||||
#define sexp_unbox_integer(n) (((sexp_sint_t)n)>>SEXP_FIXNUM_BITS)
|
||||
|
||||
#define sexp_make_character(n) ((sexp) ((((sexp_sint_t)n)<<SEXP_EXTENDED_BITS) + SEXP_CHAR_TAG))
|
||||
#define sexp_unbox_character(n) ((int) (((sexp_sint_t)n)>>SEXP_EXTENDED_BITS))
|
||||
|
||||
#define sexp_flonum_value(f) ((f)->value.flonum)
|
||||
|
||||
#define sexp_integer_to_flonum(x) (sexp_make_flonum(sexp_unbox_integer(x)))
|
||||
|
||||
#define sexp_vector_length(x) ((x)->value.vector.length)
|
||||
#define sexp_vector_data(x) ((x)->value.vector.data)
|
||||
|
||||
|
|
@ -281,11 +252,16 @@ void sexp_write_string(sexp str, sexp port);
|
|||
void sexp_printf(sexp port, sexp fmt, ...);
|
||||
#endif
|
||||
|
||||
#define sexp_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG))
|
||||
#define sexp_sub(a, b) ((sexp)(((sexp_sint_t)a)-((sexp_sint_t)b)+SEXP_FIXNUM_TAG))
|
||||
#define sexp_mul(a, b) ((sexp)((((((sexp_sint_t)a)-SEXP_FIXNUM_TAG)*(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))+SEXP_FIXNUM_TAG)))
|
||||
#define sexp_div(a, b) ((sexp)(((((sexp_sint_t)a)>>SEXP_FIXNUM_BITS)/(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))<<SEXP_FIXNUM_BITS)+SEXP_FIXNUM_TAG)
|
||||
#define sexp_mod(a, b) ((sexp)(((((sexp_sint_t)a)>>SEXP_FIXNUM_BITS)%(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))<<SEXP_FIXNUM_BITS)+SEXP_FIXNUM_TAG)
|
||||
#define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG))
|
||||
#define sexp_fx_sub(a, b) ((sexp)(((sexp_sint_t)a)-((sexp_sint_t)b)+SEXP_FIXNUM_TAG))
|
||||
#define sexp_fx_mul(a, b) ((sexp)((((((sexp_sint_t)a)-SEXP_FIXNUM_TAG)*(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))+SEXP_FIXNUM_TAG)))
|
||||
#define sexp_fx_div(a, b) ((sexp)(((((sexp_sint_t)a)>>SEXP_FIXNUM_BITS)/(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))<<SEXP_FIXNUM_BITS)+SEXP_FIXNUM_TAG)
|
||||
#define sexp_fx_mod(a, b) ((sexp)(((((sexp_sint_t)a)>>SEXP_FIXNUM_BITS)%(((sexp_sint_t)b)>>SEXP_FIXNUM_BITS))<<SEXP_FIXNUM_BITS)+SEXP_FIXNUM_TAG)
|
||||
|
||||
#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_list1(a) sexp_cons(a, SEXP_NULL)
|
||||
#define sexp_list2(a, b) sexp_cons(a, sexp_cons(b, SEXP_NULL))
|
||||
|
|
@ -342,6 +318,8 @@ sexp sexp_make_output_port(FILE* out);
|
|||
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 file, sexp line);
|
||||
sexp sexp_print_exception(sexp exn, sexp out);
|
||||
void sexp_init();
|
||||
|
||||
#endif /* ! SEXP_H */
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue