diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index 32cbc1e7..8d946273 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -187,6 +187,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_type(ctx, "", SEXP_LIT); sexp_define_type(ctx, "", SEXP_SYNCLO); sexp_define_type(ctx, "", SEXP_CONTEXT); + sexp_define_type(ctx, "", SEXP_EXCEPTION); sexp_define_type_predicate(ctx, env, "environment?", SEXP_ENV); sexp_define_type_predicate(ctx, env, "bytecode?", SEXP_BYTECODE); sexp_define_type_predicate(ctx, env, "exception?", SEXP_EXCEPTION); @@ -201,6 +202,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_type_predicate(ctx, env, "opcode?", SEXP_OPCODE); sexp_define_type_predicate(ctx, env, "type?", SEXP_TYPE); sexp_define_type_predicate(ctx, env, "context?", SEXP_CONTEXT); + sexp_define_type_predicate(ctx, env, "exception?", SEXP_EXCEPTION); sexp_define_accessors(ctx, env, SEXP_PAIR, 2, "pair-source", "pair-source-set!"); sexp_define_accessors(ctx, env, SEXP_SYNCLO, 0, "syntactic-closure-env", "syntactic-closure-env-set!"); sexp_define_accessors(ctx, env, SEXP_SYNCLO, 1, "syntactic-closure-vars", "syntactic-closure-vars-set!"); @@ -228,6 +230,9 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 1, "procedure-code", "procedure-code-set!"); sexp_define_accessors(ctx, env, SEXP_PROCEDURE, 2, "procedure-vars", "procedure-vars-set!"); sexp_define_accessors(ctx, env, SEXP_BYTECODE, 1, "bytecode-name", "bytecode-name-set!"); + sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 0, "exception-kind", "exception-kind-set!"); + sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 1, "exception-message", "exception-message-set!"); + sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 2, "exception-irritants", "exception-irritants-set!"); sexp_define_foreign_opt(ctx, env, "analyze", 2, sexp_analyze_op, SEXP_FALSE); sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env); sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell); diff --git a/lib/chibi/ast.module b/lib/chibi/ast.module index 711da431..a439bd57 100644 --- a/lib/chibi/ast.module +++ b/lib/chibi/ast.module @@ -5,10 +5,10 @@ - + pair-source pair-source-set! syntactic-closure? lambda? cnd? set? ref? seq? lit? opcode? type? - environment? bytecode? exception? macro? context? + environment? bytecode? exception? macro? context? exception? syntactic-closure-expr syntactic-closure-env syntactic-closure-vars lambda-name lambda-params lambda-body lambda-defs lambda-locals lambda-flags lambda-free-vars lambda-set-vars lambda-return-type @@ -22,6 +22,8 @@ set-var set-value set-var-set! set-value-set! ref-name ref-cell ref-name-set! ref-cell-set! seq-ls seq-ls-set! lit-value lit-value-set! + exception-kind exception-kind-set! exception-message exception-message-set! + exception-irritants exception-irritants-set! opcode-name opcode-num-params opcode-return-type opcode-param-type opcode-variadic? procedure-code procedure-vars procedure-name bytecode-name) diff --git a/lib/srfi/18.module b/lib/srfi/18.module index 930e800e..3ed564f8 100644 --- a/lib/srfi/18.module +++ b/lib/srfi/18.module @@ -17,6 +17,7 @@ uncaught-exception-reason) (import-immutable (scheme) (srfi 9) + (chibi ast) (chibi time)) (include-shared "18/threads") (include "18/types.scm" "18/interface.scm")) diff --git a/lib/srfi/18/interface.scm b/lib/srfi/18/interface.scm index 7dde92aa..3757c0b5 100644 --- a/lib/srfi/18/interface.scm +++ b/lib/srfi/18/interface.scm @@ -37,3 +37,13 @@ (define current-time get-time-of-day) (define time? timeval?) + +(define (join-timeout-exception? x) + (and (exception? x) + (equal? (exception-message x) "timed out waiting for thread"))) + +;; flush out exception types +(define (abandoned-mutex-exception? x) #f) +(define (terminated-thread-exception? x) #f) +(define (uncaught-exception? x) #f) +(define (uncaught-exception-reason x) #f)