mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 14:19:18 +02:00
preparing for preview release
This commit is contained in:
Alex Shinn
parent
b4aaf9b386
commit
609ca8df2e
10 changed files with 103 additions and 34 deletions
42
Makefile
42
Makefile
|
|
@ -9,9 +9,8 @@ LIBDIR=$(PREFIX)/lib
|
|||
INCDIR=$(PREFIX)/include/chibi-scheme
|
||||
MODDIR=$(PREFIX)/share/chibi-scheme
|
||||
|
||||
SO=.dylib
|
||||
LDFLAGS=-lm
|
||||
CFLAGS=-Wall -g -save-temps -Os
|
||||
CFLAGS=-Wall -g -Os
|
||||
|
||||
GC_OBJ=./gc/gc.a
|
||||
|
||||
|
|
@ -27,12 +26,6 @@ eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile
|
|||
main.o: main.c eval.c debug.c opcodes.c eval.h sexp.h config.h defaults.h Makefile
|
||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
|
||||
libchibisexp.$(SO): sexp.o $(GC_OBJ)
|
||||
gcc $(LDFLAGS) -shared -dynamiclib -o $@ $^
|
||||
|
||||
libchibischeme.$(SO): eval.o $(GC_OBJ)
|
||||
gcc $(LDFLAGS) -shared -dynamiclib -o $@ $^ -lchibisexp
|
||||
|
||||
chibi-scheme: main.o sexp.o $(GC_OBJ)
|
||||
gcc $(CFLAGS) $(LDFLAGS) -o $@ $^
|
||||
|
||||
|
|
@ -52,18 +45,25 @@ test: chibi-scheme
|
|||
echo "[FAIL] $${f%.scm}"; \
|
||||
fi; \
|
||||
done
|
||||
./chibi-scheme -l syntax-rules.scm tests/r5rs-tests.scm
|
||||
|
||||
install: chibi-scheme
|
||||
cp chibi-scheme $(BINDIR)/
|
||||
mkdir -p $(MODDIR)
|
||||
cp init.scm $(MODDIR)/
|
||||
mkdir -p $(INCDIR)
|
||||
cp *.h $(INCDIR)/
|
||||
cp *.$(SO) $(LIBDIR)/
|
||||
# install: chibi-scheme
|
||||
# cp chibi-scheme $(BINDIR)/
|
||||
# mkdir -p $(MODDIR)
|
||||
# cp init.scm $(MODDIR)/
|
||||
# mkdir -p $(INCDIR)
|
||||
# cp *.h $(INCDIR)/
|
||||
# cp *.$(SO) $(LIBDIR)/
|
||||
|
||||
uninstall:
|
||||
rm -f $(BINDIR)/chibi-scheme
|
||||
rm -f $(LIBDIR)/libchibischeme.$(SO)
|
||||
rm -f $(LIBDIR)/libchibisexp.$(SO)
|
||||
rm -f $(INCDIR)/*.h
|
||||
rm -f $(MODDIR)/*.scm
|
||||
# uninstall:
|
||||
# rm -f $(BINDIR)/chibi-scheme
|
||||
# rm -f $(LIBDIR)/libchibischeme.$(SO)
|
||||
# rm -f $(LIBDIR)/libchibisexp.$(SO)
|
||||
# rm -f $(INCDIR)/*.h
|
||||
# rm -f $(MODDIR)/*.scm
|
||||
|
||||
dist: cleaner
|
||||
mkdir chibi-scheme-`cat VERSION`
|
||||
for f in `hg manifest`; do mkdir -p chibi-scheme-`cat VERSION`/`dirname $$f`; ln -s $$f chibi-scheme-`cat VERSION`/$$f; done
|
||||
tar cphzvf chibi-scheme-`cat VERSION`.tar.gz chibi-scheme-`cat VERSION`
|
||||
rm -rf chibi-scheme-`cat VERSION`
|
||||
|
|
|
|||
26
README
Normal file
26
README
Normal file
|
|
@ -0,0 +1,26 @@
|
|||
|
||||
Chibi-Scheme
|
||||
--------------
|
||||
|
||||
Simple and Minimal Scheme Implementation
|
||||
|
||||
http://synthcode.com/scheme/chibi-scheme/
|
||||
|
||||
version 0.1
|
||||
April 8, 2009
|
||||
|
||||
|
||||
Chibi-Scheme is a very small but mostly complete R5RS Scheme
|
||||
implementation using a reasonably fast custom VM. Chibi-Scheme tries
|
||||
as much as possible not to trade its small size by cutting corners,
|
||||
and provides full continuations, both low and high-level hygienic
|
||||
macros based on syntactic-closures, and string ports and exceptions.
|
||||
Chibi-Scheme is written in highly portable C and supports multiple
|
||||
simultaneous VM instances to run.
|
||||
|
||||
To build, just run "make". You can edit the file config.h for a
|
||||
number of settings, mostly disabling features to make the executable
|
||||
smaller. Documents and examples for using Chibi-Scheme as a library
|
||||
for extension scripting will be provided in an upcoming release.
|
||||
|
||||
syntax-rules must be loaded manually from the file syntax-rules.scm.
|
||||
1
VERSION
Normal file
1
VERSION
Normal file
|
|
@ -0,0 +1 @@
|
|||
0.1
|
||||
5
debug.c
5
debug.c
|
|
@ -3,8 +3,9 @@
|
|||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
static const char* reverse_opcode_names[] =
|
||||
{"NOOP", "ERROR", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL",
|
||||
"FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "EVAL", "JUMP-UNLESS",
|
||||
{"NOOP", "RAISE", "RESUMECC", "CALLCC", "APPLY1", "TAIL-CALL", "CALL",
|
||||
"FCALL0", "FCALL1", "FCALL2", "FCALL3", "FCALL4", "FCALL5", "FCALL6",
|
||||
"EVAL", "JUMP-UNLESS",
|
||||
"JUMP", "PUSH", "DROP", "GLOBAL-REF", "GLOBAL-KNOWN-REF", "STACK-REF",
|
||||
"LOCAL-REF", "LOCAL-SET",
|
||||
"CLOSURE-REF", "VECTOR-REF", "VECTOR-SET", "VECTOR-LENGTH", "STRING-REF",
|
||||
|
|
|
|||
|
|
@ -52,6 +52,10 @@
|
|||
#define USE_FAST_LET 1
|
||||
#endif
|
||||
|
||||
#ifndef USE_CHECK_STACK
|
||||
#define USE_CHECK_STACK 0
|
||||
#endif
|
||||
|
||||
#if USE_BOEHM
|
||||
#include "gc/include/gc.h"
|
||||
#define sexp_alloc GC_malloc
|
||||
|
|
|
|||
28
eval.c
28
eval.c
|
|
@ -989,6 +989,7 @@ static sexp_uint_t sexp_restore_stack(sexp saved, sexp *current) {
|
|||
#define _ARG3 stack[top-3]
|
||||
#define _ARG4 stack[top-4]
|
||||
#define _ARG5 stack[top-5]
|
||||
#define _ARG6 stack[top-6]
|
||||
#define _PUSH(x) (stack[top++]=(x))
|
||||
#define _WORD0 ((sexp*)ip)[0]
|
||||
#define _UWORD0 ((sexp_uint_t*)ip)[0]
|
||||
|
|
@ -1020,7 +1021,7 @@ sexp vm (sexp self, sexp context, sexp* stack, sexp_sint_t top) {
|
|||
switch (*ip++) {
|
||||
case OP_NOOP:
|
||||
break;
|
||||
case OP_ERROR:
|
||||
case OP_RAISE:
|
||||
call_error_handler:
|
||||
stack[top] = (sexp) 1;
|
||||
stack[top+1] = sexp_make_integer(ip);
|
||||
|
|
@ -1087,8 +1088,10 @@ sexp vm (sexp self, sexp context, sexp* stack, sexp_sint_t top) {
|
|||
fp = sexp_unbox_integer(tmp2);
|
||||
goto make_call;
|
||||
case OP_CALL:
|
||||
#if USE_CHECK_STACK
|
||||
if (top >= INIT_STACK_SIZE)
|
||||
sexp_raise("out of stack space", SEXP_NULL);
|
||||
#endif
|
||||
i = sexp_unbox_integer(_WORD0);
|
||||
tmp1 = _ARG1;
|
||||
make_call:
|
||||
|
|
@ -1164,6 +1167,18 @@ sexp vm (sexp self, sexp context, sexp* stack, sexp_sint_t top) {
|
|||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL5:
|
||||
_ARG5 =((sexp_proc5)_UWORD0)(_ARG1, _ARG2, _ARG3, _ARG4, _ARG5);
|
||||
top -= 4;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_FCALL6:
|
||||
_ARG6 =((sexp_proc6)_UWORD0)(_ARG1, _ARG2, _ARG3, _ARG4, _ARG5, _ARG6);
|
||||
top -= 5;
|
||||
ip += sizeof(sexp);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_EVAL:
|
||||
sexp_context_top(context) = top;
|
||||
_ARG1 = eval_in_context(_ARG1, context);
|
||||
|
|
@ -1534,6 +1549,13 @@ sexp vm (sexp self, sexp context, sexp* stack, sexp_sint_t top) {
|
|||
|
||||
/************************ library procedures **************************/
|
||||
|
||||
static sexp sexp_exception_type_func (sexp exn) {
|
||||
if (sexp_exceptionp(exn))
|
||||
return sexp_exception_kind(exn);
|
||||
else
|
||||
return sexp_type_exception("not an exception", exn);
|
||||
}
|
||||
|
||||
static sexp sexp_open_input_file (sexp path) {
|
||||
FILE *in;
|
||||
if (! sexp_stringp(path)) return sexp_type_exception("not a string", path);
|
||||
|
|
@ -1800,8 +1822,8 @@ void scheme_init () {
|
|||
if (! scheme_initialized_p) {
|
||||
scheme_initialized_p = 1;
|
||||
sexp_init();
|
||||
the_compile_error_symbol = sexp_intern("compile-error");
|
||||
the_err_handler_symbol = sexp_intern("*current-error-handler*");
|
||||
the_compile_error_symbol = sexp_intern("compile");
|
||||
the_err_handler_symbol = sexp_intern("*current-exception-handler*");
|
||||
the_cur_in_symbol = sexp_intern("*current-input-port*");
|
||||
the_cur_out_symbol = sexp_intern("*current-output-port*");
|
||||
the_cur_err_symbol = sexp_intern("*current-error-port*");
|
||||
|
|
|
|||
5
eval.h
5
eval.h
|
|
@ -24,7 +24,6 @@ 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,
|
||||
|
|
@ -54,7 +53,7 @@ enum opcode_classes {
|
|||
|
||||
enum opcode_names {
|
||||
OP_NOOP,
|
||||
OP_ERROR,
|
||||
OP_RAISE,
|
||||
OP_RESUMECC,
|
||||
OP_CALLCC,
|
||||
OP_APPLY1,
|
||||
|
|
@ -65,6 +64,8 @@ enum opcode_names {
|
|||
OP_FCALL2,
|
||||
OP_FCALL3,
|
||||
OP_FCALL4,
|
||||
OP_FCALL5,
|
||||
OP_FCALL6,
|
||||
OP_EVAL,
|
||||
OP_JUMP_UNLESS,
|
||||
OP_JUMP,
|
||||
|
|
|
|||
10
init.scm
10
init.scm
|
|
@ -264,6 +264,16 @@
|
|||
|
||||
(define (force x) (if (procedure? x) (x) x))
|
||||
|
||||
(define (error msg . args)
|
||||
(raise (make-exception 'user msg args #f #f #f)))
|
||||
|
||||
(define (with-exception-handler handler thunk)
|
||||
(let ((orig-handler (current-exception-handler)))
|
||||
(current-exception-handler handler)
|
||||
(let ((res (thunk)))
|
||||
(current-exception-handler orig-handler)
|
||||
res)))
|
||||
|
||||
;; booleans
|
||||
|
||||
(define (not x) (if x #f #t))
|
||||
|
|
|
|||
|
|
@ -9,6 +9,8 @@
|
|||
#define _FN2OPT(t, u, s, f, d) _FN(OP_FCALL2, 1, 1, t, u, s, f, d)
|
||||
#define _FN3(t, u, s, f, d) _FN(OP_FCALL3, 3, 0, t, u, s, f, d)
|
||||
#define _FN4(t, u, s, f, d) _FN(OP_FCALL4, 4, 0, t, u, s, f, d)
|
||||
#define _FN5(t, u, s, f, d) _FN(OP_FCALL5, 5, 0, t, u, s, f, d)
|
||||
#define _FN6(t, u, s, f, d) _FN(OP_FCALL6, 6, 0, t, u, s, f, d)
|
||||
#define _PARAM(n, a, t) _OP(OPC_PARAMETER, OP_NOOP, 0, 3, t, 0, 0, n, a, 0)
|
||||
|
||||
static struct sexp_struct opcodes[] = {
|
||||
|
|
@ -58,7 +60,7 @@ _OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "input-port?", 0, (sexp)SEXP_I
|
|||
_OP(OPC_TYPE_PREDICATE, OP_TYPEP, 1, 0, 0, 0, 0, "output-port?", 0, (sexp)SEXP_OPORT),
|
||||
_OP(OPC_GENERIC, OP_APPLY1, 2, 0, SEXP_PROCEDURE, SEXP_PAIR, 0, "apply1", 0, NULL),
|
||||
_OP(OPC_GENERIC, OP_CALLCC, 1, SEXP_PROCEDURE, 0, 0, 0, "call-with-current-continuation", 0, NULL),
|
||||
_OP(OPC_GENERIC, OP_ERROR, 1, SEXP_STRING, 0, 0, 0, "error", 0, NULL),
|
||||
_OP(OPC_GENERIC, OP_RAISE, 1, SEXP_STRING, 0, 0, 0, "raise", 0, NULL),
|
||||
_OP(OPC_IO, OP_WRITE, 1, 3, 0, SEXP_OPORT, 0, "write", (sexp)"*current-output-port*", NULL),
|
||||
_OP(OPC_IO, OP_DISPLAY, 1, 3, 0, SEXP_OPORT, 0, "display", (sexp)"*current-output-port*", NULL),
|
||||
_OP(OPC_IO, OP_WRITE_CHAR, 1, 3, 0, SEXP_OPORT, 0, "write-char", (sexp)"*current-output-port*", NULL),
|
||||
|
|
@ -83,6 +85,8 @@ _FN1(SEXP_FIXNUM, "null-environment", 0, sexp_make_null_env),
|
|||
_FN1(SEXP_FIXNUM, "scheme-report-environment", 0, sexp_make_standard_env),
|
||||
_FN2(SEXP_STRING, SEXP_ENV, "%load", 0, sexp_load),
|
||||
_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),
|
||||
|
|
@ -95,7 +99,7 @@ _FN3(SEXP_ENV, SEXP_PAIR, "make-syntactic-closure", 0, sexp_make_synclo),
|
|||
_PARAM("current-input-port", (sexp)"*current-input-port*", SEXP_IPORT),
|
||||
_PARAM("current-output-port", (sexp)"*current-output-port*", SEXP_OPORT),
|
||||
_PARAM("current-error-port", (sexp)"*current-error-port*", SEXP_OPORT),
|
||||
_PARAM("current-error-handler", (sexp)"*current-error-handler*", SEXP_PROCEDURE),
|
||||
_PARAM("current-exception-handler", (sexp)"*current-exception-handler*", SEXP_PROCEDURE),
|
||||
_PARAM("interaction-environment", (sexp)"*interaction-environment*", SEXP_ENV),
|
||||
#if USE_MATH
|
||||
_FN1(0, "exp", 0, sexp_exp),
|
||||
|
|
|
|||
8
sexp.c
8
sexp.c
|
|
@ -104,7 +104,7 @@ sexp sexp_make_exception (sexp kind, sexp message, sexp irritants,
|
|||
}
|
||||
|
||||
sexp sexp_user_exception (sexp self, char *message, sexp irritants) {
|
||||
return sexp_make_exception(sexp_intern("user-error"),
|
||||
return sexp_make_exception(sexp_intern("user"),
|
||||
sexp_c_string(message),
|
||||
((sexp_pairp(irritants) || sexp_nullp(irritants))
|
||||
? irritants : sexp_list1(irritants)),
|
||||
|
|
@ -112,13 +112,13 @@ sexp sexp_user_exception (sexp self, char *message, sexp irritants) {
|
|||
}
|
||||
|
||||
sexp sexp_type_exception (char *message, sexp obj) {
|
||||
return sexp_make_exception(sexp_intern("type-error"),
|
||||
return sexp_make_exception(sexp_intern("type"),
|
||||
sexp_c_string(message), sexp_list1(obj),
|
||||
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
|
||||
}
|
||||
|
||||
sexp sexp_range_exception (sexp obj, sexp start, sexp end) {
|
||||
return sexp_make_exception(sexp_intern("range-error"),
|
||||
return sexp_make_exception(sexp_intern("range"),
|
||||
sexp_c_string("bad index range"),
|
||||
sexp_list3(obj, start, end),
|
||||
SEXP_FALSE, SEXP_FALSE, SEXP_FALSE);
|
||||
|
|
@ -1135,7 +1135,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_read_error_symbol = sexp_intern("read");
|
||||
the_empty_vector = sexp_alloc_type(vector, SEXP_VECTOR);
|
||||
sexp_vector_length(the_empty_vector) = 0;
|
||||
sexp_vector_data(the_empty_vector) = NULL;
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue