diff --git a/scheme/ikarus.boot.orig b/scheme/ikarus.boot.orig index d2eff4a..7239e84 100644 Binary files a/scheme/ikarus.boot.orig and b/scheme/ikarus.boot.orig differ diff --git a/scheme/ikarus.conditions.ss b/scheme/ikarus.conditions.ss index 8e39130..b3cfbb3 100644 --- a/scheme/ikarus.conditions.ss +++ b/scheme/ikarus.conditions.ss @@ -33,6 +33,8 @@ i/o-port-error? i/o-error-port make-i/o-decoding-error i/o-decoding-error? make-i/o-encoding-error i/o-encoding-error? i/o-encoding-error-char + no-infinities-violation? make-no-infinities-violation + no-nans-violation? make-no-nans-violation &condition-rtd &condition-rcd &message-rtd &message-rcd &warning-rtd &warning-rcd &serious-rtd &serious-rcd @@ -51,7 +53,8 @@ &i/o-file-already-exists-rcd &i/o-file-does-not-exist-rtd &i/o-file-does-not-exist-rcd &i/o-port-rtd &i/o-port-rcd &i/o-decoding-rtd &i/o-decoding-rcd &i/o-encoding-rtd - &i/o-encoding-rcd + &i/o-encoding-rcd &no-infinities-rtd &no-infinities-rcd + &no-nans-rtd &no-nans-rcd ) (import @@ -90,6 +93,8 @@ i/o-port-error? i/o-error-port make-i/o-decoding-error i/o-decoding-error? make-i/o-encoding-error i/o-encoding-error? i/o-encoding-error-char + no-infinities-violation? make-no-infinities-violation + no-nans-violation? make-no-nans-violation )) @@ -289,5 +294,11 @@ make-i/o-encoding-error i/o-encoding-error? (char i/o-encoding-error-char)) + (define-condition-type &no-infinities &implementation-restriction + make-no-infinities-violation no-infinities-violation?) + + (define-condition-type &no-nans &implementation-restriction + make-no-nans-violation no-nans-violation?) + ) diff --git a/scheme/makefile.ss b/scheme/makefile.ss index 6f2808c..806983a 100755 --- a/scheme/makefile.ss +++ b/scheme/makefile.ss @@ -174,6 +174,8 @@ [&i/o-port ($core-rtd . (&i/o-port-rtd &i/o-port-rcd))] [&i/o-decoding ($core-rtd . (&i/o-decoding-rtd &i/o-decoding-rcd))] [&i/o-encoding ($core-rtd . (&i/o-encoding-rtd &i/o-encoding-rcd))] + [&no-infinities ($core-rtd . (&no-infinities-rtd &no-infinities-rcd ))] + [&no-nans ($core-rtd . (&no-nans-rtd &no-nans-rcd ))] )) (define library-legend @@ -1295,6 +1297,10 @@ [&i/o-decoding-rcd] [&i/o-encoding-rtd] [&i/o-encoding-rcd] + [&no-infinities-rtd] + [&no-infinities-rcd] + [&no-nans-rtd] + [&no-nans-rcd] )) (define (macro-identifier? x) diff --git a/scheme/todo-r6rs.ss b/scheme/todo-r6rs.ss index 2dd9e7d..426dba2 100755 --- a/scheme/todo-r6rs.ss +++ b/scheme/todo-r6rs.ss @@ -40,7 +40,6 @@ [S scheduled] [D deferred] [C completed] - [X killed] )) (define identifier-names @@ -348,12 +347,12 @@ [fltruncate C fl] [flzero? C fl] [real->flonum D fl] - [make-no-infinities-violation X fl] - [make-no-nans-violation X fl] - [&no-infinities X fl] - [no-infinities-violation? X fl] - [&no-nans X fl] - [no-nans-violation? X fl] + [make-no-infinities-violation C fl] + [make-no-nans-violation C fl] + [&no-infinities C fl] + [no-infinities-violation? C fl] + [&no-nans C fl] + [no-nans-violation? C fl] ;;; [bytevector->sint-list C bv] [bytevector->u8-list C bv] @@ -414,58 +413,58 @@ [utf16->string S bv] [utf32->string S bv] ;;; - [condition? X co] - [&assertion X co] - [assertion-violation? X co] - [&condition X co] - [condition X co] - [condition-accessor X co] - [condition-irritants X co] - [condition-message X co] - [condition-predicate X co] - [condition-who X co] - [define-condition-type X co] - [&error X co] - [error? X co] - [&implementation-restriction X co] - [implementation-restriction-violation? X co] - [&irritants X co] - [irritants-condition? X co] - [&lexical X co] - [lexical-violation? X co] - [make-assertion-violation X co] - [make-error X co] - [make-implementation-restriction-violation X co] - [make-irritants-condition X co] - [make-lexical-violation X co] - [make-message-condition X co] - [make-non-continuable-violation X co] - [make-serious-condition X co] - [make-syntax-violation X co] - [make-undefined-violation X co] - [make-violation X co] - [make-warning X co] - [make-who-condition X co] - [&message X co] - [message-condition? X co] - [&non-continuable X co] - [non-continuable-violation? X co] - [&serious X co] - [serious-condition? X co] - [simple-conditions X co] - [&syntax X co] - [syntax-violation X co sc] - [syntax-violation-form X co] - [syntax-violation-subform X co] - [syntax-violation? X co] - [&undefined X co] - [undefined-violation? X co] - [&violation X co] - [violation? X co] - [&warning X co] - [warning? X co] - [&who X co] - [who-condition? X co] + [condition? C co] + [&assertion C co] + [assertion-violation? C co] + [&condition C co] + [condition C co] + [condition-accessor C co] + [condition-irritants C co] + [condition-message C co] + [condition-predicate C co] + [condition-who C co] + [define-condition-type S co] + [&error C co] + [error? C co] + [&implementation-restriction C co] + [implementation-restriction-violation? C co] + [&irritants C co] + [irritants-condition? C co] + [&lexical C co] + [lexical-violation? C co] + [make-assertion-violation C co] + [make-error C co] + [make-implementation-restriction-violation C co] + [make-irritants-condition C co] + [make-lexical-violation C co] + [make-message-condition C co] + [make-non-continuable-violation C co] + [make-serious-condition C co] + [make-syntax-violation C co] + [make-undefined-violation C co] + [make-violation C co] + [make-warning C co] + [make-who-condition C co] + [&message C co] + [message-condition? C co] + [&non-continuable C co] + [non-continuable-violation? C co] + [&serious C co] + [serious-condition? C co] + [simple-conditions C co] + [&syntax C co] + [syntax-violation C co sc] + [syntax-violation-form C co] + [syntax-violation-subform C co] + [syntax-violation? C co] + [&undefined C co] + [undefined-violation? C co] + [&violation C co] + [violation? C co] + [&warning C co] + [warning? C co] + [&who C co] + [who-condition? C co] ;;; [case-lambda C ct] [do C ct se ne] @@ -490,10 +489,10 @@ [environment C ev] [eval C ev se] ;;; - [raise X ex] - [raise-continuable X ex] - [with-exception-handler X ex] - [guard X ex] + [raise S ex] + [raise-continuable S ex] + [with-exception-handler S ex] + [guard S ex] ;;; [binary-port? S ip] [buffer-mode C ip] @@ -559,33 +558,33 @@ [get-string-n S ip] [get-string-n! S ip] [get-u8 S ip] - [&i/o X ip is fi] - [&i/o-decoding X ip] - [i/o-decoding-error? X ip] - [&i/o-encoding X ip] - [i/o-encoding-error-char X ip] - [i/o-encoding-error? X ip] - [i/o-error-filename X ip is fi] - [i/o-error-port X ip is fi] - [i/o-error? X ip is fi] - [&i/o-file-already-exists X ip is fi] - [i/o-file-already-exists-error? X ip is fi] - [&i/o-file-does-not-exist X ip is fi] - [i/o-file-does-not-exist-error? X ip is fi] - [&i/o-file-is-read-only X ip is fi] - [i/o-file-is-read-only-error? X ip is fi] - [&i/o-file-protection X ip is fi] - [i/o-file-protection-error? X ip is fi] - [&i/o-filename X ip is fi] - [i/o-filename-error? X ip is fi] - [&i/o-invalid-position X ip is fi] - [i/o-invalid-position-error? X ip is fi] - [&i/o-port X ip is fi] - [i/o-port-error? X ip is fi] - [&i/o-read X ip is fi] - [i/o-read-error? X ip is fi] - [&i/o-write X ip is fi] - [i/o-write-error? X ip is fi] + [&i/o C ip is fi] + [&i/o-decoding C ip] + [i/o-decoding-error? C ip] + [&i/o-encoding C ip] + [i/o-encoding-error-char C ip] + [i/o-encoding-error? C ip] + [i/o-error-filename C ip is fi] + [i/o-error-port C ip is fi] + [i/o-error? C ip is fi] + [&i/o-file-already-exists C ip is fi] + [i/o-file-already-exists-error? C ip is fi] + [&i/o-file-does-not-exist C ip is fi] + [i/o-file-does-not-exist-error? C ip is fi] + [&i/o-file-is-read-only C ip is fi] + [i/o-file-is-read-only-error? C ip is fi] + [&i/o-file-protection C ip is fi] + [i/o-file-protection-error? C ip is fi] + [&i/o-filename C ip is fi] + [i/o-filename-error? C ip is fi] + [&i/o-invalid-position C ip is fi] + [i/o-invalid-position-error? C ip is fi] + [&i/o-port C ip is fi] + [i/o-port-error? C ip is fi] + [&i/o-read C ip is fi] + [i/o-read-error? C ip is fi] + [&i/o-write C ip is fi] + [i/o-write-error? C ip is fi] [lookahead-char S ip] [lookahead-u8 S ip] [make-bytevector C bv] @@ -595,18 +594,19 @@ [make-custom-textual-input-port S ip] [make-custom-textual-input/output-port D ip] [make-custom-textual-output-port S ip] - [make-i/o-decoding-error X ip] - [make-i/o-encoding-error X ip] - [make-i/o-error X ip is fi] - [make-i/o-file-already-exists-error X ip is fi] - [make-i/o-file-does-not-exist-error X ip is fi] - [make-i/o-file-is-read-only-error X ip is fi] - [make-i/o-file-protection-error X ip is fi] - [make-i/o-filename-error X ip is fi] - [make-i/o-invalid-position-error X ip is fi] - [make-i/o-port-error X ip is fi] - [make-i/o-read-error X ip is fi] - [make-i/o-write-error X ip is fi] + + [make-i/o-decoding-error C ip] + [make-i/o-encoding-error C ip] + [make-i/o-error C ip is fi] + [make-i/o-file-already-exists-error C ip is fi] + [make-i/o-file-does-not-exist-error C ip is fi] + [make-i/o-file-is-read-only-error C ip is fi] + [make-i/o-file-protection-error C ip is fi] + [make-i/o-filename-error C ip is fi] + [make-i/o-invalid-position-error C ip is fi] + [make-i/o-port-error C ip is fi] + [make-i/o-read-error C ip is fi] + [make-i/o-write-error C ip is fi] [latin-1-codec C ip] [make-transcoder C ip] [native-eol-style C ip] @@ -695,7 +695,7 @@ [file-exists? C fi] [delete-file C fi] ;;; - [define-record-type S rs] + [define-record-type C rs] [fields C rs] [immutable C rs] [mutable C rs]