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

eval.c

@@ -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

include/chibi/sexp.h

@@ -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);

lib/scheme/base.sld

@@ -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

lib/scheme/extras.scm

@@ -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)

sexp.c

@@ -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);