Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 14:19:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

making basic port operations (open-{in,out}put-file, close-port)

Browse source 
as well as identifier?, identifier=? and identifier->symbol available
from the C API (fixes #55).
This commit is contained in:
Alex Shinn 2010-12-06 21:06:46 -08:00
parent a7c9e0982a
commit c4b3e128f1
2 changed files with 17 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
eval.c
View file

@ -394,15 +394,15 @@ sexp sexp_make_child_context (sexp ctx, sexp lambda) {
/**************************** identifiers *****************************/ /**************************** identifiers *****************************/
static sexp sexp_identifierp_op (sexp ctx sexp_api_params(self, n), sexp x) { sexp sexp_identifierp_op (sexp ctx sexp_api_params(self, n), sexp x) {
return sexp_make_boolean(sexp_idp(x)); return sexp_make_boolean(sexp_idp(x));
} }
static sexp sexp_syntactic_closure_expr_op (sexp ctx sexp_api_params(self, n), sexp x) { sexp sexp_syntactic_closure_expr_op (sexp ctx sexp_api_params(self, n), sexp x) {
return (sexp_synclop(x) ? sexp_synclo_expr(x) : x); return (sexp_synclop(x) ? sexp_synclo_expr(x) : x);
} }
static sexp sexp_strip_synclos (sexp ctx sexp_api_params(self, n), sexp x) { sexp sexp_strip_synclos (sexp ctx sexp_api_params(self, n), sexp x) {
sexp res; sexp res;
sexp_gc_var2(kar, kdr); sexp_gc_var2(kar, kdr);
sexp_gc_preserve2(ctx, kar, kdr); sexp_gc_preserve2(ctx, kar, kdr);
@ -422,7 +422,7 @@ static sexp sexp_strip_synclos (sexp ctx sexp_api_params(self, n), sexp x) {
return res; return res;
} }
static sexp sexp_identifier_eq_op (sexp ctx sexp_api_params(self, n), sexp e1, sexp id1, sexp e2, sexp id2) { sexp sexp_identifier_eq_op (sexp ctx sexp_api_params(self, n), sexp e1, sexp id1, sexp e2, sexp id2) {
sexp cell, lam1=SEXP_FALSE, lam2=SEXP_FALSE; sexp cell, lam1=SEXP_FALSE, lam2=SEXP_FALSE;
if (sexp_synclop(id1)) { if (sexp_synclop(id1)) {
e1 = sexp_synclo_env(id1); e1 = sexp_synclo_env(id1);
@ -908,7 +908,7 @@ static sexp sexp_exception_type_op (sexp ctx sexp_api_params(self, n), sexp exn)
return sexp_exception_kind(exn); return sexp_exception_kind(exn);
} }
static sexp sexp_open_input_file_op (sexp ctx sexp_api_params(self, n), sexp path) { sexp sexp_open_input_file_op (sexp ctx sexp_api_params(self, n), sexp path) {
FILE *in; FILE *in;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, path); sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, path);
in = fopen(sexp_string_data(path), "r"); in = fopen(sexp_string_data(path), "r");
@ -917,7 +917,7 @@ static sexp sexp_open_input_file_op (sexp ctx sexp_api_params(self, n), sexp pat
return sexp_make_input_port(ctx, in, path); return sexp_make_input_port(ctx, in, path);
} }
static sexp sexp_open_output_file_op (sexp ctx sexp_api_params(self, n), sexp path) { sexp sexp_open_output_file_op (sexp ctx sexp_api_params(self, n), sexp path) {
FILE *out; FILE *out;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, path); sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, path);
out = fopen(sexp_string_data(path), "w"); out = fopen(sexp_string_data(path), "w");
@ -926,7 +926,7 @@ static sexp sexp_open_output_file_op (sexp ctx sexp_api_params(self, n), sexp pa
return sexp_make_output_port(ctx, out, path); return sexp_make_output_port(ctx, out, path);
} }
static sexp sexp_close_port_op (sexp ctx sexp_api_params(self, n), sexp port) { sexp sexp_close_port_op (sexp ctx sexp_api_params(self, n), sexp port) {
sexp_assert_type(ctx, sexp_portp, SEXP_OPORT, port); sexp_assert_type(ctx, sexp_portp, SEXP_OPORT, port);
if (! sexp_port_openp(port)) if (! sexp_port_openp(port))
return sexp_user_exception(ctx, self, "port already closed", port); return sexp_user_exception(ctx, self, "port already closed", port);

14
include/chibi/eval.h
View file

@ -153,9 +153,15 @@ SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version);
SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file); SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env); SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
SEXP_API sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp); SEXP_API sexp sexp_add_module_directory_op (sexp ctx sexp_api_params(self, n), sexp dir, sexp appendp);
SEXP_API sexp sexp_extend_env (sexp context, sexp env, sexp vars, sexp value); SEXP_API sexp sexp_extend_env (sexp ctx, sexp env, sexp vars, sexp value);
SEXP_API sexp sexp_env_copy_op (sexp context sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp); SEXP_API sexp sexp_env_copy_op (sexp ctx sexp_api_params(self, n), sexp to, sexp from, sexp ls, sexp immutp);
SEXP_API sexp sexp_env_define (sexp context, sexp env, sexp sym, sexp val); SEXP_API sexp sexp_identifier_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_syntactic_closure_expr(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_identifier_eq_op(sexp ctx sexp_api_params(self, n), sexp a, sexp b, sexp c, sexp d);
SEXP_API sexp sexp_open_input_file_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_open_output_file_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_close_port_op(sexp ctx sexp_api_params(self, n), sexp x);
SEXP_API sexp sexp_env_define (sexp ctx, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym); SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt); SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt); SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt);
@ -191,7 +197,7 @@ SEXP_API sexp sexp_make_setter_op (sexp ctx sexp_api_params(self, n), sexp name,
#define sexp_eval(ctx, x, e) sexp_eval_op(ctx sexp_api_pass(NULL, 2), x, e) #define sexp_eval(ctx, x, e) sexp_eval_op(ctx sexp_api_pass(NULL, 2), x, e)
#define sexp_load(ctx, f, e) sexp_load_op(ctx sexp_api_pass(NULL, 2), f, e) #define sexp_load(ctx, f, e) sexp_load_op(ctx sexp_api_pass(NULL, 2), f, e)
#define sexp_env_copy(ctx, a, b, c, d) sexp_env_copy_op(ctx sexp_api_pass(NULL, 4), a, b, c, d) #define sexp_env_copy(ctx, a, b, c, d) sexp_env_copy_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
#define sexp_identifierp(ctx, x) sexp_identifier_op(ctx sexp_api_pass(NULL, 1), x) #define sexp_identifierp(ctx, x) sexp_identifierp_op(ctx sexp_api_pass(NULL, 1), x)
#define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx sexp_api_pass(NULL, 1), x) #define sexp_identifier_to_symbol(ctx, x) sexp_syntactic_closure_expr(ctx sexp_api_pass(NULL, 1), x)
#define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx sexp_api_pass(NULL, 4), a, b, c, d) #define sexp_identifier_eq(ctx, a, b, c, d) sexp_identifier_eq_op(ctx sexp_api_pass(NULL, 4), a, b, c, d)
#define sexp_open_input_file(ctx, x) sexp_open_input_file_op(ctx sexp_api_pass(NULL, 1), x) #define sexp_open_input_file(ctx, x) sexp_open_input_file_op(ctx sexp_api_pass(NULL, 1), x)