Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-16 17:37:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding file-error? and read-error? predicates.

Browse source
This commit is contained in:
Alex Shinn 2012-10-14 23:27:16 +09:00
parent 42f3b77b46
commit 74d0980b82
5 changed files with 21 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
eval.c
View file

@ -1086,7 +1086,7 @@ sexp sexp_open_input_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp path) {
in = fopen(sexp_string_data(path), "r");
} while (!in && sexp_out_of_file_descriptors() && !count++);
if (!in)
return sexp_user_exception(ctx, self, "couldn't open input file", path);
return sexp_file_exception(ctx, self, "couldn't open input file", path);
#if SEXP_USE_GREEN_THREADS
fcntl(fileno(in), F_SETFL, O_NONBLOCK);
#endif
@ -1102,7 +1102,7 @@ sexp sexp_open_output_file_op (sexp ctx, sexp self, sexp_sint_t n, sexp path) {
out = fopen(sexp_string_data(path), "w");
} while (!out && sexp_out_of_file_descriptors() && !count++);
if (!out)
return sexp_user_exception(ctx, self, "couldn't open output file", path);
return sexp_file_exception(ctx, self, "couldn't open output file", path);
#if SEXP_USE_GREEN_THREADS
fcntl(fileno(out), F_SETFL, O_NONBLOCK);
#endif

1
include/chibi/sexp.h
View file

@ -1373,6 +1373,7 @@ SEXP_API sexp sexp_make_output_string_port_op (sexp ctx, sexp self, sexp_sint_t
SEXP_API sexp sexp_get_output_string_op (sexp ctx, sexp self, sexp_sint_t n, sexp port);
SEXP_API sexp sexp_make_exception (sexp ctx, sexp kind, sexp message, sexp irritants, sexp procedure, sexp source);
SEXP_API sexp sexp_user_exception (sexp ctx, sexp self, const char *msg, sexp x);
SEXP_API sexp sexp_file_exception (sexp ctx, sexp self, const char *msg, sexp x);
SEXP_API sexp sexp_type_exception (sexp ctx, sexp self, sexp_uint_t type_id, sexp x);
SEXP_API sexp sexp_xtype_exception (sexp ctx, sexp self, const char *msg, sexp x);
SEXP_API sexp sexp_range_exception (sexp ctx, sexp obj, sexp start, sexp end);

5
lib/scheme/base.sld
View file

@ -23,7 +23,8 @@
define-record-type define-syntax define-values denominator do
dynamic-wind else eof-object? eq? equal? eqv? error
error-object-irritants error-object-message error-object? even?
exact exact-integer-sqrt exact-integer? exact? expt features floor
exact exact-integer-sqrt exact-integer? exact? expt features
file-error? floor
flush-output-port for-each gcd get-output-bytevector get-output-string
guard if import include include-ci inexact inexact? input-port?
integer->char
@ -36,7 +37,7 @@
open-output-string or output-port? pair? parameterize peek-char
peek-u8 port-open? port? positive? procedure? quasiquote quote
quotient raise raise-continuable rational? rationalize read-bytevector
read-bytevector! read-char read-line read-u8 real? remainder
read-bytevector! read-char read-error? read-line read-u8 real? remainder
reverse round set! set-car! set-cdr! string string->list
string->number string->symbol string->utf8 string->vector string-append
string-copy string-fill! string-for-each string-length string-map

6
lib/scheme/extras.scm
View file

@ -23,6 +23,12 @@
((null? files) (cons (rename 'begin) (reverse res)))
(else (lp (cdr files) (append (read-sexps (car files) #t) res))))))))
(define (read-error? x)
(and (error-object? x) (eq? 'read (exception-type x))))
(define (file-error? x)
(and (error-object? x) (eq? 'file (exception-type x))))
(define (features) *features*)
(define exact inexact->exact)

9
sexp.c
View file

@ -536,6 +536,15 @@ sexp sexp_user_exception (sexp ctx, sexp self, const char *ms, sexp ir) {
return res;
}
sexp sexp_file_exception (sexp ctx, sexp self, const char *ms, sexp ir) {
sexp_gc_var1(res);
sexp_gc_preserve1(ctx, res);
res = sexp_user_exception(ctx, self, ms, ir);
sexp_exception_kind(res) = sexp_intern(ctx, "file", -1);
sexp_gc_release1(ctx);
return res;
}
static sexp type_exception (sexp ctx, sexp self, sexp str, sexp obj, sexp src) {
sexp_gc_var2(res, sym);
sexp_gc_preserve2(ctx, res, sym);