mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-08 13:37:35 +02:00
switching to linking as a library
This commit is contained in:
Alex Shinn
parent
56dcf497de
commit
24d9bfc950
8 changed files with 170 additions and 115 deletions
62
Makefile
62
Makefile
|
|
@ -1,29 +1,65 @@
|
|||
# -*- makefile-gmake -*-
|
||||
|
||||
.PHONY: all doc dist clean cleaner test install uninstall
|
||||
|
||||
all: chibi-scheme
|
||||
|
||||
PREFIX=/usr/local
|
||||
CC ?= cc
|
||||
PREFIX ?= /usr/local
|
||||
BINDIR=$(PREFIX)/bin
|
||||
LIBDIR=$(PREFIX)/lib
|
||||
INCDIR=$(PREFIX)/include/chibi-scheme
|
||||
MODDIR=$(PREFIX)/share/chibi-scheme
|
||||
INCDIR=$(PREFIX)/include/chibi
|
||||
MODDIR=$(PREFIX)/share/chibi
|
||||
|
||||
LDFLAGS=-lm #-lgc -L/opt/local/lib
|
||||
ifndef PLATFORM
|
||||
ifeq ($(shell uname),Darwin)
|
||||
PLATFORM=macosx
|
||||
else
|
||||
PLATFORM=unix
|
||||
endif
|
||||
endif
|
||||
|
||||
CFLAGS=-Wall -O2 -g #-I/opt/local/include #-save-temps
|
||||
ifeq ($(PLATFORM),macosx)
|
||||
SO = .dylib
|
||||
EXE =
|
||||
CLIBFLAGS = -dynamiclib
|
||||
else ifeq ($(PLATFORM),mingw)
|
||||
SO = .dll
|
||||
EXE = .exe
|
||||
CLIBFLAGS = -fPIC shared
|
||||
else
|
||||
SO = .so
|
||||
EXE =
|
||||
CLIBFLAGS = -fPIC -shared
|
||||
endif
|
||||
|
||||
sexp.o: sexp.c gc.c sexp.h config.h Makefile
|
||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
ifdef USE_BOEHM
|
||||
GCLDFLAGS := -lgc
|
||||
else
|
||||
GCLDFLAGS :=
|
||||
endif
|
||||
|
||||
eval.o: eval.c debug.c opcodes.c eval.h sexp.h config.h Makefile
|
||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
LDFLAGS := $(LDFLAGS) -lm
|
||||
CPPFLAGS := $(CPPFLAGS) -Iinclude
|
||||
CFLAGS := $(CFLAGS) -Wall -O2 -g
|
||||
|
||||
main.o: main.c eval.c debug.c opcodes.c eval.h sexp.h config.h Makefile
|
||||
gcc -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
sexp.o: sexp.c gc.c include/chibi/sexp.h include/chibi/config.h Makefile
|
||||
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
|
||||
chibi-scheme: main.o sexp.o
|
||||
gcc $(CFLAGS) $(LDFLAGS) -o $@ $^
|
||||
eval.o: eval.c debug.c opcodes.c include/chibi/eval.h include/chibi/sexp.h include/chibi/config.h Makefile
|
||||
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
|
||||
main.o: main.c eval.c debug.c opcodes.c include/chibi/eval.h include/chibi/sexp.h include/chibi/config.h Makefile
|
||||
$(CC) -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
|
||||
|
||||
libchibi-scheme$(SO): eval.o sexp.o
|
||||
$(CC) -dynamiclib -o $@ $^
|
||||
|
||||
chibi-scheme$(EXE): main.o libchibi-scheme$(SO)
|
||||
$(CC) $(CPPFLAGS) $(CFLAGS) -o $@ $< $(LDFLAGS) $(GCLDFLAGS) -L. -lchibi-scheme
|
||||
|
||||
chibi-scheme-static$(EXE): main.o eval.o sexp.o
|
||||
$(CC) $(CFLAGS) -o $@ $^ $(LDFLAGS) $(GCLDFLAGS)
|
||||
|
||||
clean:
|
||||
rm -f *.o *.i *.s
|
||||
|
|
|
|||
75
eval.c
75
eval.c
|
|
@ -2,7 +2,7 @@
|
|||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "eval.h"
|
||||
#include "chibi/eval.h"
|
||||
|
||||
/************************************************************************/
|
||||
|
||||
|
|
@ -248,7 +248,7 @@ static sexp sexp_make_lit(sexp ctx, sexp value) {
|
|||
|
||||
#define SEXP_STACK_SIZE (sexp_sizeof(stack)+sizeof(sexp)*INIT_STACK_SIZE)
|
||||
|
||||
static sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
||||
sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
||||
sexp_gc_var(ctx, res, save_res);
|
||||
if (ctx) sexp_gc_preserve(ctx, res, save_res);
|
||||
res = sexp_alloc_type(ctx, context, SEXP_CONTEXT);
|
||||
|
|
@ -279,7 +279,7 @@ static sexp sexp_make_context(sexp ctx, sexp stack, sexp env) {
|
|||
return res;
|
||||
}
|
||||
|
||||
static sexp sexp_make_child_context(sexp context, sexp lambda) {
|
||||
sexp sexp_make_child_context(sexp context, sexp lambda) {
|
||||
sexp ctx = sexp_make_context(context,
|
||||
sexp_context_stack(context),
|
||||
sexp_context_env(context));
|
||||
|
|
@ -582,7 +582,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
|
|||
&& sexp_nullp(sexp_cddar(ls)))) {
|
||||
res = sexp_compile_error(eval_ctx, "bad syntax binding", sexp_car(ls));
|
||||
} else {
|
||||
proc = eval_in_context(eval_ctx, sexp_cadar(ls));
|
||||
proc = sexp_eval(eval_ctx, sexp_cadar(ls));
|
||||
if (sexp_exceptionp(proc)) {
|
||||
res = proc;
|
||||
break;
|
||||
|
|
@ -697,7 +697,7 @@ static sexp analyze (sexp ctx, sexp object) {
|
|||
tmp = sexp_cons(ctx, sexp_macro_env(op), SEXP_NULL);
|
||||
tmp = sexp_cons(ctx, sexp_context_env(ctx), tmp);
|
||||
tmp = sexp_cons(ctx, x, tmp);
|
||||
x = apply(sexp_make_child_context(ctx, sexp_context_lambda(ctx)),
|
||||
x = sexp_apply(sexp_make_child_context(ctx, sexp_context_lambda(ctx)),
|
||||
sexp_macro_proc(op),
|
||||
tmp);
|
||||
/* if (in_repl_p) sexp_debug(" => ", x, ctx); */
|
||||
|
|
@ -1216,7 +1216,7 @@ static sexp_uint_t sexp_restore_stack(sexp saved, sexp *current) {
|
|||
goto call_error_handler;} \
|
||||
while (0)
|
||||
|
||||
sexp vm (sexp ctx, sexp proc) {
|
||||
sexp sexp_vm (sexp ctx, sexp proc) {
|
||||
sexp bc = sexp_procedure_code(proc), cp = sexp_procedure_vars(proc);
|
||||
sexp env = sexp_context_env(ctx),
|
||||
*stack = sexp_stack_data(sexp_context_stack(ctx));
|
||||
|
|
@ -1414,7 +1414,7 @@ sexp vm (sexp ctx, sexp proc) {
|
|||
break;
|
||||
case OP_EVAL:
|
||||
sexp_context_top(ctx) = top;
|
||||
_ARG1 = eval_in_context(ctx, _ARG1);
|
||||
_ARG1 = sexp_eval(ctx, _ARG1);
|
||||
sexp_check_exception();
|
||||
break;
|
||||
case OP_JUMP_UNLESS:
|
||||
|
|
@ -1830,7 +1830,7 @@ static sexp sexp_close_port (sexp ctx, sexp port) {
|
|||
return SEXP_VOID;
|
||||
}
|
||||
|
||||
static void sexp_warn_undefs (sexp from, sexp to, sexp out) {
|
||||
void sexp_warn_undefs (sexp from, sexp to, sexp out) {
|
||||
sexp x;
|
||||
for (x=from; sexp_pairp(x) && x!=to; x=sexp_cdr(x))
|
||||
if (sexp_cdar(x) == SEXP_UNDEF) {
|
||||
|
|
@ -1862,7 +1862,7 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
|
|||
res = in;
|
||||
} else {
|
||||
while ((x=sexp_read(ctx, in)) != (sexp) SEXP_EOF) {
|
||||
res = eval_in_context(ctx2, x);
|
||||
res = sexp_eval(ctx2, x);
|
||||
if (sexp_exceptionp(res))
|
||||
break;
|
||||
}
|
||||
|
|
@ -2013,23 +2013,26 @@ static sexp sexp_make_null_env (sexp ctx, sexp version) {
|
|||
|
||||
static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
||||
sexp_uint_t i;
|
||||
sexp cell, sym;
|
||||
sexp ctx2, cell, sym, perr_cell, err_cell;
|
||||
sexp_gc_var(ctx, e, s_e);
|
||||
sexp_gc_var(ctx, op, s_op);
|
||||
sexp_gc_var(ctx, tmp, s_tmp);
|
||||
sexp_gc_var(ctx, err_handler, s_err);
|
||||
sexp_gc_preserve(ctx, e, s_e);
|
||||
sexp_gc_preserve(ctx, op, s_op);
|
||||
sexp_gc_preserve(ctx, tmp, s_tmp);
|
||||
sexp_gc_preserve(ctx, err_handler, s_err);
|
||||
e = sexp_make_null_env(ctx, version);
|
||||
for (i=0; i<(sizeof(opcodes)/sizeof(opcodes[0])); i++) {
|
||||
/* op = &opcodes[i]; */
|
||||
op = sexp_copy_opcode(ctx, &opcodes[i]);
|
||||
if (sexp_opcode_opt_param_p(op) && sexp_opcode_default(op)) {
|
||||
/* op = sexp_copy_opcode(ctx, op); */
|
||||
sym = sexp_intern(ctx, (char*)sexp_opcode_default(op));
|
||||
cell = env_cell_create(ctx, e, sym, SEXP_VOID);
|
||||
sexp_opcode_default(op) = cell;
|
||||
}
|
||||
env_define(ctx, e, sexp_intern(ctx, sexp_opcode_name(op)), op);
|
||||
}
|
||||
/* add io port and interaction env parameters */
|
||||
env_define(ctx, e, the_cur_in_symbol,
|
||||
sexp_make_input_port(ctx, stdin, SEXP_FALSE));
|
||||
env_define(ctx, e, the_cur_out_symbol,
|
||||
|
|
@ -2037,13 +2040,35 @@ static sexp sexp_make_standard_env (sexp ctx, sexp version) {
|
|||
env_define(ctx, e, the_cur_err_symbol,
|
||||
sexp_make_output_port(ctx, stderr, SEXP_FALSE));
|
||||
env_define(ctx, e, the_interaction_env_symbol, e);
|
||||
/* add default exception handler */
|
||||
err_cell = env_cell(e, the_cur_err_symbol);
|
||||
perr_cell = env_cell(e, sexp_intern(ctx, "print-exception"));
|
||||
ctx2 = sexp_make_context(ctx, sexp_context_stack(ctx), e);
|
||||
sexp_context_tailp(ctx2) = 0;
|
||||
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
|
||||
emit(ctx2, OP_GLOBAL_KNOWN_REF);
|
||||
emit_word(ctx2, (sexp_uint_t)err_cell);
|
||||
emit(ctx2, OP_LOCAL_REF);
|
||||
emit_word(ctx2, 0);
|
||||
emit(ctx2, OP_FCALL2);
|
||||
emit_word(ctx2, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell)));
|
||||
}
|
||||
emit_push(ctx2, SEXP_VOID);
|
||||
emit(ctx2, OP_DONE);
|
||||
tmp = sexp_make_vector(ctx2, 0, SEXP_VOID);
|
||||
err_handler = sexp_make_procedure(ctx2,
|
||||
sexp_make_integer(0),
|
||||
sexp_make_integer(0),
|
||||
finalize_bytecode(ctx2),
|
||||
tmp);
|
||||
env_define(ctx2, e, the_err_handler_symbol, err_handler);
|
||||
sexp_gc_release(ctx, e, s_e);
|
||||
return e;
|
||||
}
|
||||
|
||||
/************************** eval interface ****************************/
|
||||
|
||||
sexp apply (sexp ctx, sexp proc, sexp args) {
|
||||
sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
|
||||
sexp ls, *stack = sexp_stack_data(sexp_context_stack(ctx));
|
||||
sexp_sint_t top = sexp_context_top(ctx), offset;
|
||||
offset = top + sexp_unbox_integer(sexp_length(ctx, args));
|
||||
|
|
@ -2055,10 +2080,10 @@ sexp apply (sexp ctx, sexp proc, sexp args) {
|
|||
stack[top++] = sexp_make_integer(sexp_bytecode_data(final_resumer));
|
||||
stack[top++] = sexp_make_vector(ctx, 0, SEXP_VOID);
|
||||
stack[top++] = sexp_make_integer(0);
|
||||
return vm(ctx, proc);
|
||||
return sexp_vm(ctx, proc);
|
||||
}
|
||||
|
||||
sexp compile (sexp ctx, sexp x) {
|
||||
sexp sexp_compile (sexp ctx, sexp x) {
|
||||
sexp_gc_var(ctx, ast, s_ast);
|
||||
sexp_gc_var(ctx, ctx2, s_ctx2);
|
||||
sexp_gc_var(ctx, vec, s_vec);
|
||||
|
|
@ -2084,11 +2109,11 @@ sexp compile (sexp ctx, sexp x) {
|
|||
return res;
|
||||
}
|
||||
|
||||
sexp eval_in_context (sexp ctx, sexp obj) {
|
||||
sexp sexp_eval (sexp ctx, sexp obj) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, thunk, s_thunk);
|
||||
sexp_gc_preserve(ctx, thunk, s_thunk);
|
||||
thunk = compile(ctx, obj);
|
||||
thunk = sexp_compile(ctx, obj);
|
||||
if (sexp_exceptionp(thunk)) {
|
||||
sexp_print_exception(ctx, thunk,
|
||||
env_global_ref(sexp_context_env(ctx),
|
||||
|
|
@ -2096,19 +2121,23 @@ sexp eval_in_context (sexp ctx, sexp obj) {
|
|||
SEXP_FALSE));
|
||||
res = thunk;
|
||||
} else {
|
||||
res = apply(ctx, thunk, SEXP_NULL);
|
||||
res = sexp_apply(ctx, thunk, SEXP_NULL);
|
||||
}
|
||||
sexp_gc_release(ctx, thunk, s_thunk);
|
||||
return res;
|
||||
}
|
||||
|
||||
sexp eval (sexp obj, sexp env) {
|
||||
sexp ctx = sexp_make_context(NULL, NULL, NULL);
|
||||
sexp_context_env(ctx) = env;
|
||||
return eval_in_context(ctx, obj);
|
||||
sexp sexp_eval_string (sexp ctx, char *str) {
|
||||
sexp res;
|
||||
sexp_gc_var(ctx, obj, s_obj);
|
||||
sexp_gc_preserve(ctx, obj, s_obj);
|
||||
obj = sexp_read_from_string(ctx, str);
|
||||
res = sexp_eval(ctx, obj);
|
||||
sexp_gc_release(ctx, obj, s_obj);
|
||||
return res;
|
||||
}
|
||||
|
||||
void scheme_init () {
|
||||
void sexp_scheme_init () {
|
||||
sexp ctx;
|
||||
if (! scheme_initialized_p) {
|
||||
scheme_initialized_p = 1;
|
||||
|
|
|
|||
2
gc.c
2
gc.c
|
|
@ -2,7 +2,7 @@
|
|||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "sexp.h"
|
||||
#include "chibi/sexp.h"
|
||||
|
||||
#define SEXP_INITIAL_HEAP_SIZE (2*1024*1024)
|
||||
#define SEXP_MAXIMUM_HEAP_SIZE 0
|
||||
|
|
|
|||
|
|
@ -14,7 +14,7 @@
|
|||
/* uncomment this if you only want fixnum support */
|
||||
/* #define USE_FLONUMS 0 */
|
||||
|
||||
/* uncomment this if you want immediate flonums (experimental) */
|
||||
/* uncomment this if you want immediate flonums */
|
||||
/* #define USE_IMMEDIATE_FLONUMS 1 */
|
||||
|
||||
/* uncomment this if you don't need extended math operations */
|
||||
|
|
@ -32,8 +32,8 @@
|
|||
/* uncomment this to disable string ports */
|
||||
/* #define USE_STRING_STREAMS 0 */
|
||||
|
||||
/* uncomment this to disable stack checks */
|
||||
/* #define USE_CHECK_STACK 0 */
|
||||
/* uncomment this to enable stack overflow checks */
|
||||
/* #define USE_CHECK_STACK 1 */
|
||||
|
||||
/* uncomment this to enable debugging utilities */
|
||||
/* #define USE_DEBUG 1 */
|
||||
|
|
@ -101,6 +101,6 @@
|
|||
#endif
|
||||
|
||||
#ifndef USE_CHECK_STACK
|
||||
#define USE_CHECK_STACK 1
|
||||
#define USE_CHECK_STACK 0
|
||||
#endif
|
||||
|
||||
|
|
@ -14,8 +14,6 @@
|
|||
|
||||
#define sexp_init_file "init.scm"
|
||||
|
||||
#define sexp_debug(msg, obj, ctx) (sexp_write_string(msg,env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)), sexp_write(obj, env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)), sexp_write_char('\n',env_global_ref(sexp_context_env(ctx), the_cur_err_symbol, SEXP_FALSE)))
|
||||
|
||||
/* procedure types */
|
||||
typedef sexp (*sexp_proc0) ();
|
||||
typedef sexp (*sexp_proc1) (sexp);
|
||||
|
|
@ -130,9 +128,13 @@ enum opcode_names {
|
|||
|
||||
/**************************** prototypes ******************************/
|
||||
|
||||
sexp apply(sexp proc, sexp args, sexp context);
|
||||
sexp eval_in_context(sexp expr, sexp context);
|
||||
sexp eval(sexp expr, sexp env);
|
||||
SEXP_API void sexp_scheme_init();
|
||||
SEXP_API sexp sexp_apply(sexp context, sexp proc, sexp args);
|
||||
SEXP_API sexp sexp_eval(sexp context, sexp obj);
|
||||
SEXP_API sexp sexp_eval_string(sexp context, char *str);
|
||||
SEXP_API sexp sexp_load(sexp context, sexp expr, sexp env);
|
||||
SEXP_API sexp sexp_make_context(sexp context, sexp stack, sexp env);
|
||||
SEXP_API void sexp_warn_undefs (sexp from, sexp to, sexp out);
|
||||
|
||||
#endif /* ! SEXP_EVAL_H */
|
||||
|
||||
|
|
@ -16,6 +16,10 @@
|
|||
#include <sys/types.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef SEXP_API
|
||||
#define SEXP_API extern
|
||||
#endif
|
||||
|
||||
/* tagging system
|
||||
* bits end in 00: pointer
|
||||
* 01: fixnum
|
||||
|
|
@ -511,43 +515,43 @@ sexp sexp_make_flonum(sexp ctx, double f);
|
|||
#define sexp_scanf(p, ...) (fscanf(sexp_port_stream(p), __VA_ARGS__))
|
||||
#define sexp_flush(p) (fflush(sexp_port_stream(p)))
|
||||
|
||||
sexp sexp_alloc_tagged(sexp ctx, size_t size, sexp_uint_t tag);
|
||||
sexp sexp_cons(sexp ctx, sexp head, sexp tail);
|
||||
sexp sexp_list2(sexp ctx, sexp a, sexp b);
|
||||
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_sint_t slen);
|
||||
sexp sexp_make_string(sexp ctx, sexp len, sexp ch);
|
||||
sexp sexp_substring (sexp ctx, sexp str, sexp start, sexp end);
|
||||
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);
|
||||
sexp sexp_read_string(sexp ctx, sexp in);
|
||||
sexp sexp_read_symbol(sexp ctx, sexp in, int init, int internp);
|
||||
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, sexp name);
|
||||
sexp sexp_make_output_port(sexp ctx, FILE* out, sexp name);
|
||||
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();
|
||||
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_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_c_string(sexp ctx, 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_intern(sexp ctx, char *str);
|
||||
SEXP_API sexp sexp_string_to_symbol(sexp ctx, 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_vector(sexp ctx, int count, ...);
|
||||
SEXP_API void sexp_write(sexp obj, 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_from_string(sexp ctx, char *str);
|
||||
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_exception(sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp file, sexp line);
|
||||
SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, char *message, sexp obj);
|
||||
SEXP_API sexp sexp_type_exception (sexp ctx, char *message, sexp obj);
|
||||
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 void sexp_init();
|
||||
|
||||
#endif /* ! SEXP_H */
|
||||
|
||||
41
main.c
41
main.c
|
|
@ -1,5 +1,8 @@
|
|||
/* main.c -- chibi-scheme command-line app using */
|
||||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "eval.c"
|
||||
#include "chibi/eval.h"
|
||||
|
||||
void repl (sexp ctx) {
|
||||
sexp tmp, res, env, in, out, err;
|
||||
|
|
@ -7,9 +10,9 @@ void repl (sexp ctx) {
|
|||
sexp_gc_preserve(ctx, obj, s_obj);
|
||||
env = sexp_context_env(ctx);
|
||||
sexp_context_tracep(ctx) = 1;
|
||||
in = env_global_ref(env, the_cur_in_symbol, SEXP_FALSE);
|
||||
out = env_global_ref(env, the_cur_out_symbol, SEXP_FALSE);
|
||||
err = env_global_ref(env, the_cur_err_symbol, SEXP_FALSE);
|
||||
in = sexp_eval_string(ctx, "(current-input-port)");
|
||||
out = sexp_eval_string(ctx, "(current-output-port)");
|
||||
err = sexp_eval_string(ctx, "(current-error-port)");
|
||||
while (1) {
|
||||
sexp_write_string("> ", out);
|
||||
sexp_flush(out);
|
||||
|
|
@ -21,7 +24,7 @@ void repl (sexp ctx) {
|
|||
} else {
|
||||
tmp = sexp_env_bindings(env);
|
||||
sexp_context_top(ctx) = 0;
|
||||
res = eval_in_context(ctx, obj);
|
||||
res = sexp_eval(ctx, obj);
|
||||
#if USE_WARN_UNDEFS
|
||||
sexp_warn_undefs(sexp_env_bindings(env), tmp, err);
|
||||
#endif
|
||||
|
|
@ -35,34 +38,14 @@ void repl (sexp ctx) {
|
|||
}
|
||||
|
||||
void run_main (int argc, char **argv) {
|
||||
sexp env, out=NULL, res, ctx, perr_cell, err_cell, err_handler;
|
||||
sexp env, out=NULL, res, ctx;
|
||||
sexp_uint_t i, quit=0, init_loaded=0;
|
||||
sexp_gc_var(ctx, str, s_str);
|
||||
|
||||
ctx = sexp_make_context(NULL, NULL, NULL);
|
||||
sexp_gc_preserve(ctx, str, s_str);
|
||||
env = sexp_context_env(ctx);
|
||||
env_define(ctx, 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(ctx, "print-exception"));
|
||||
sexp_context_tailp(ctx) = 0;
|
||||
if (err_cell && perr_cell && sexp_opcodep(sexp_cdr(perr_cell))) {
|
||||
emit(ctx, OP_GLOBAL_KNOWN_REF);
|
||||
emit_word(ctx, (sexp_uint_t)err_cell);
|
||||
emit(ctx, OP_LOCAL_REF);
|
||||
emit_word(ctx, 0);
|
||||
emit(ctx, OP_FCALL2);
|
||||
emit_word(ctx, (sexp_uint_t)sexp_opcode_data(sexp_cdr(perr_cell)));
|
||||
}
|
||||
emit_push(ctx, SEXP_VOID);
|
||||
emit(ctx, OP_DONE);
|
||||
err_handler = sexp_make_procedure(ctx,
|
||||
sexp_make_integer(0),
|
||||
sexp_make_integer(0),
|
||||
finalize_bytecode(ctx),
|
||||
sexp_make_vector(ctx, 0, SEXP_VOID));
|
||||
env_define(ctx, env, the_err_handler_symbol, err_handler);
|
||||
out = sexp_eval_string(ctx, "(current-output-port)");
|
||||
|
||||
/* parse options */
|
||||
for (i=1; i < argc && argv[i][0] == '-'; i++) {
|
||||
|
|
@ -74,7 +57,7 @@ void run_main (int argc, char **argv) {
|
|||
sexp_load(ctx, str=sexp_c_string(ctx, sexp_init_file, -1), env);
|
||||
res = sexp_read_from_string(ctx, argv[i+1]);
|
||||
if (! sexp_exceptionp(res))
|
||||
res = eval_in_context(ctx, res);
|
||||
res = sexp_eval(ctx, res);
|
||||
if (sexp_exceptionp(res)) {
|
||||
sexp_print_exception(ctx, res, out);
|
||||
} else if (argv[i][1] == 'p') {
|
||||
|
|
@ -112,7 +95,7 @@ void run_main (int argc, char **argv) {
|
|||
}
|
||||
|
||||
int main (int argc, char **argv) {
|
||||
scheme_init();
|
||||
sexp_scheme_init();
|
||||
run_main(argc, argv);
|
||||
return 0;
|
||||
}
|
||||
|
|
|
|||
3
sexp.c
3
sexp.c
|
|
@ -2,7 +2,8 @@
|
|||
/* Copyright (c) 2009 Alex Shinn. All rights reserved. */
|
||||
/* BSD-style license: http://synthcode.com/license.txt */
|
||||
|
||||
#include "sexp.h"
|
||||
#define SEXP_API
|
||||
#include "chibi/sexp.h"
|
||||
|
||||
/* optional huffman-compressed immediate symbols */
|
||||
#if USE_HUFF_SYMS
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue