From 66147f27b4edf6892df00b219acb78b800f8a19c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 13 Aug 2015 01:56:32 -0700 Subject: [PATCH] extra: use throw-foo for ERROR: change --- .../cxx/demangle/libstdcxx/libstdcxx.factor | 6 ++-- extra/alien/fortran/fortran.factor | 18 +++++----- extra/arrays/shaped/shaped.factor | 8 ++--- extra/asn1/asn1.factor | 2 +- extra/audio/audio.factor | 2 +- extra/audio/chunked-file/chunked-file.factor | 2 +- extra/audio/engine/engine.factor | 4 +-- extra/audio/loader/loader.factor | 2 +- extra/audio/vorbis/vorbis.factor | 8 ++--- extra/backtrack/backtrack.factor | 2 +- extra/base85/base85.factor | 4 +-- .../chameneos-redux/chameneos-redux.factor | 2 +- extra/benchmark/tcp-echo0/tcp-echo0.factor | 4 +-- extra/bit/ly/ly.factor | 2 +- extra/bloom-filters/bloom-filters.factor | 8 ++--- extra/bson/reader/reader.factor | 4 +-- extra/c/preprocessor/preprocessor.factor | 4 +-- extra/cairo-demo/cairo-demo.factor | 2 +- extra/constructors/constructors.factor | 4 +-- extra/cpu/8080/emulator/emulator.factor | 2 +- extra/crypto/aes/aes.factor | 4 +-- extra/crypto/xor/xor.factor | 2 +- extra/cuda/cuda.factor | 2 +- extra/cuda/libraries/libraries.factor | 6 ++-- extra/cuda/nvcc/nvcc.factor | 2 +- extra/cuesheet/cuesheet.factor | 2 +- extra/curses/curses.factor | 6 ++-- extra/cursors/cursors.factor | 8 +++-- extra/decimals/decimals-tests.factor | 2 +- extra/decimals/decimals.factor | 2 +- extra/descriptive/descriptive.factor | 2 +- extra/dns/dns.factor | 2 +- extra/forestdb/lib/lib.factor | 4 +-- extra/forestdb/paths/paths.factor | 4 +-- extra/fullscreen/fullscreen.factor | 6 ++-- extra/game/models/collada/collada.factor | 4 +-- extra/game/models/loader/loader.factor | 4 +-- extra/gopher/gopher.factor | 2 +- extra/gpu/render/render.factor | 4 +-- extra/gpu/shaders/shaders.factor | 6 ++-- extra/graphviz/render/render.factor | 2 +- extra/html/parser/analyzer/analyzer.factor | 2 +- extra/images/atlas/atlas.factor | 2 +- extra/images/bitmap/bitmap.factor | 4 +-- extra/images/gif/gif.factor | 12 +++---- extra/images/png/png.factor | 2 +- extra/images/tga/tga.factor | 32 ++++++++--------- extra/images/tiff/tiff.factor | 36 +++++++++---------- extra/imap/imap-tests.factor | 2 +- extra/imap/imap.factor | 2 +- extra/infix/infix.factor | 4 +-- extra/io/binary/fast/fast.factor | 2 +- extra/io/files/acls/macosx/ffi/ffi.factor | 2 +- extra/io/files/acls/macosx/macosx.factor | 2 +- extra/io/streams/zeros/zeros.factor | 2 +- extra/ip-parser/ip-parser.factor | 2 +- .../rebalancing/rebalancing.factor | 2 +- extra/macho/macho.factor | 2 +- extra/managed-server/managed-server.factor | 4 +-- extra/mason/common/common.factor | 2 +- extra/math/derivatives/derivatives.factor | 2 +- extra/math/matrices/laplace/laplace.factor | 2 +- extra/math/transforms/fft/fft.factor | 4 +-- extra/memcached/memcached.factor | 16 ++++----- extra/memory/piles/piles.factor | 2 +- extra/metar/metar.factor | 2 +- extra/money/money.factor | 2 +- extra/mongodb/connection/connection.factor | 5 ++- extra/mongodb/driver/driver.factor | 2 +- extra/morse/morse.factor | 2 +- extra/msgpack/msgpack.factor | 14 ++++---- extra/noise/noise.factor | 2 +- extra/opencl/ffi/ffi-tests.factor | 2 +- extra/opencl/opencl.factor | 6 ++-- extra/pair-methods/pair-methods.factor | 2 +- extra/pairs/pairs.factor | 2 +- extra/pcre/pcre.factor | 6 ++-- extra/poker/poker.factor | 4 +-- extra/progress-bars/progress-bars.factor | 4 +-- .../response-parser/response-parser.factor | 2 +- extra/resolv-conf/resolv-conf.factor | 4 +-- extra/roles/roles.factor | 4 +-- extra/smalltalk/classes/classes.factor | 2 +- extra/smalltalk/compiler/lexenv/lexenv.factor | 4 +-- extra/smalltalk/parser/parser.factor | 2 +- extra/tar/tar.factor | 2 +- extra/taxes/usa/fica/fica.factor | 2 +- extra/terminfo/terminfo.factor | 2 +- extra/tzinfo/tzinfo.factor | 2 +- extra/units/units.factor | 2 +- extra/usa-cities/usa-cities.factor | 2 +- extra/uu/uu.factor | 4 +-- extra/vocabs/git/git.factor | 2 +- extra/yaml/yaml.factor | 14 ++++---- extra/zoneinfo/zoneinfo.factor | 2 +- 95 files changed, 212 insertions(+), 205 deletions(-) diff --git a/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor b/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor index 3487423504..43e33d3991 100644 --- a/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor +++ b/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor @@ -13,9 +13,9 @@ ERROR: invalid-demangle-args name ; : demangle-error ( name status -- ) { { 0 [ drop ] } - { -1 [ drop demangle-memory-allocation-failure ] } - { -2 [ invalid-mangled-name ] } - { -3 [ invalid-demangle-args ] } + { -1 [ drop throw-demangle-memory-allocation-failure ] } + { -2 [ throw-invalid-mangled-name ] } + { -3 [ throw-invalid-demangle-args ] } } case ; : mangled-name? ( name -- ? ) diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor index 34405c6c87..2d5d98d01f 100755 --- a/extra/alien/fortran/fortran.factor +++ b/extra/alien/fortran/fortran.factor @@ -102,12 +102,12 @@ CONSTANT: fortran>c-types H{ dims>> [ product 2array ] when* ; MACRO: size-case-type ( cases -- quot ) - [ invalid-fortran-type ] suffix + [ throw-invalid-fortran-type ] suffix '[ [ size>> _ case ] [ append-dimensions ] bi ] ; : simple-type ( type base-c-type -- c-type ) swap - [ dup size>> [ invalid-fortran-type ] [ drop ] if ] + [ dup size>> [ throw-invalid-fortran-type ] [ drop ] if ] [ append-dimensions ] bi ; : new-fortran-type ( out? dims size class -- type ) @@ -150,7 +150,7 @@ M: misc-type (fortran-type>c-type) : fix-character-type ( character-type -- character-type' ) clone dup size>> - [ dup dims>> [ invalid-fortran-type ] [ dup size>> 1array >>dims f >>size ] if ] + [ dup dims>> [ throw-invalid-fortran-type ] [ dup size>> 1array >>dims f >>size ] if ] [ dup dims>> [ ] [ f >>dims ] if ] if dup single-char? [ f >>dims ] when ; @@ -212,7 +212,7 @@ M: integer-type (fortran-arg>c-args) { 2 [ [ c:short ] [ drop ] ] } { 4 [ [ c:int ] [ drop ] ] } { 8 [ [ c:longlong ] [ drop ] ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] args?dims ; @@ -225,7 +225,7 @@ M: real-type (fortran-arg>c-args) { f [ [ c:float ] [ drop ] ] } { 4 [ [ c:float ] [ drop ] ] } { 8 [ [ c:double ] [ drop ] ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] args?dims ; @@ -235,7 +235,7 @@ M: real-complex-type (fortran-arg>c-args) { f [ [ ] [ drop ] ] } { 8 [ [ ] [ drop ] ] } { 16 [ [ ] [ drop ] ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] args?dims ; @@ -266,7 +266,7 @@ M: integer-type (fortran-result>) { 2 [ { [ c:short deref ] } ] } { 4 [ { [ c:int deref ] } ] } { 8 [ { [ c:longlong deref ] } ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] result?dims ; @@ -278,7 +278,7 @@ M: real-type (fortran-result>) { f [ { [ c:float deref ] } ] } { 4 [ { [ c:float deref ] } ] } { 8 [ { [ c:double deref ] } ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] result?dims ; M: real-complex-type (fortran-result>) @@ -286,7 +286,7 @@ M: real-complex-type (fortran-result>) { f [ { [ *complex-float ] } ] } { 8 [ { [ *complex-float ] } ] } { 16 [ { [ *complex-double ] } ] } - [ invalid-fortran-type ] + [ throw-invalid-fortran-type ] } case ] result?dims ; M: double-precision-type (fortran-result>) diff --git a/extra/arrays/shaped/shaped.factor b/extra/arrays/shaped/shaped.factor index 70f985c78d..b411ebd132 100644 --- a/extra/arrays/shaped/shaped.factor +++ b/extra/arrays/shaped/shaped.factor @@ -47,7 +47,7 @@ M: sequence shape array-replace wrap-shape ; ERROR: no-negative-shape-components shape ; : check-shape-domain ( seq -- seq ) - dup [ 0 < ] any? [ no-negative-shape-components ] when ; + dup [ 0 < ] any? [ throw-no-negative-shape-components ] when ; GENERIC: shape-capacity ( shape -- n ) @@ -68,20 +68,20 @@ ERROR: no-abnormally-shaped-arrays underlying shape ; GENERIC: check-underlying-shape ( underlying shape -- underlying shape ) M: abnormal-shape check-underlying-shape - no-abnormally-shaped-arrays ; + throw-no-abnormally-shaped-arrays ; M: uniform-shape check-underlying-shape shape>> check-underlying-shape ; M: sequence check-underlying-shape 2dup [ length ] [ shape-capacity ] bi* - = [ underlying-shape-mismatch ] unless ; inline + = [ throw-underlying-shape-mismatch ] unless ; inline ERROR: shape-mismatch shaped0 shaped1 ; : check-shape ( shaped-array shaped-array -- shaped-array shaped-array ) 2dup [ shape>> ] bi@ - sequence= [ shape-mismatch ] unless ; + sequence= [ throw-shape-mismatch ] unless ; TUPLE: shaped-array underlying shape ; TUPLE: row-array < shaped-array ; diff --git a/extra/asn1/asn1.factor b/extra/asn1/asn1.factor index ad86a8877d..40819a1302 100644 --- a/extra/asn1/asn1.factor +++ b/extra/asn1/asn1.factor @@ -76,7 +76,7 @@ ERROR: unsupported-tag-encoding id ; elements get id>> 31 bitand dup elements get tag<< 31 < [ - get-id unsupported-tag-encoding + get-id throw-unsupported-tag-encoding ] unless ; : set-tagclass ( -- ) diff --git a/extra/audio/audio.factor b/extra/audio/audio.factor index dab3be1363..fcd36a27bb 100644 --- a/extra/audio/audio.factor +++ b/extra/audio/audio.factor @@ -19,5 +19,5 @@ ERROR: format-unsupported-by-openal audio ; { { 1 16 } [ drop AL_FORMAT_MONO16 ] } { { 2 8 } [ drop AL_FORMAT_STEREO8 ] } { { 2 16 } [ drop AL_FORMAT_STEREO16 ] } - [ drop format-unsupported-by-openal ] + [ drop throw-format-unsupported-by-openal ] } case ; diff --git a/extra/audio/chunked-file/chunked-file.factor b/extra/audio/chunked-file/chunked-file.factor index 271e56b171..01f2d9b109 100644 --- a/extra/audio/chunked-file/chunked-file.factor +++ b/extra/audio/chunked-file/chunked-file.factor @@ -8,7 +8,7 @@ ERROR: invalid-audio-file ; : ensured-read ( count -- output/f ) [ read ] keep over length = [ drop f ] unless ; : ensured-read* ( count -- output ) - ensured-read [ invalid-audio-file ] unless* ; + ensured-read [ throw-invalid-audio-file ] unless* ; : read-chunk ( -- byte-array/f ) 4 ensured-read [ 4 ensured-read* dup endian> ensured-read* 3append ] [ f ] if* ; diff --git a/extra/audio/engine/engine.factor b/extra/audio/engine/engine.factor index 5da13cd33e..16d82ca55e 100644 --- a/extra/audio/engine/engine.factor +++ b/extra/audio/engine/engine.factor @@ -94,11 +94,11 @@ ERROR: audio-context-not-available device-name ; :: ( device-name voice-count -- engine ) [ device-name alcOpenDevice :> al-device - al-device [ device-name audio-device-not-found ] unless + al-device [ device-name throw-audio-device-not-found ] unless al-device |alcCloseDevice* drop al-device f alcCreateContext :> al-context - al-context [ device-name audio-context-not-available ] unless + al-context [ device-name throw-audio-context-not-available ] unless al-context |alcDestroyContext drop al-context alcSuspendContext diff --git a/extra/audio/loader/loader.factor b/extra/audio/loader/loader.factor index d1cb43aa3c..ba2a346f7d 100644 --- a/extra/audio/loader/loader.factor +++ b/extra/audio/loader/loader.factor @@ -14,7 +14,7 @@ audio-types [ H{ } clone ] initialize : read-audio ( path -- audio ) dup file-extension >lower audio-types get ?at [ call( path -- audio ) ] - [ unknown-audio-extension ] if ; + [ throw-unknown-audio-extension ] if ; "audio.wav" require "audio.aiff" require diff --git a/extra/audio/vorbis/vorbis.factor b/extra/audio/vorbis/vorbis.factor index d8036b4ee0..eae8b48509 100644 --- a/extra/audio/vorbis/vorbis.factor +++ b/extra/audio/vorbis/vorbis.factor @@ -48,7 +48,7 @@ ERROR: no-vorbis-in-ogg ; stream>> read-bytes-into ; inline : ?ogg-error ( n -- ) - dup 0 < [ ogg-error ] [ drop ] if ; inline + dup 0 < [ throw-ogg-error ] [ drop ] if ; inline : confirm-buffer ( len vorbis-stream -- ? ) '[ _ sync-state>> swap ogg_sync_wrote ?ogg-error ] keep zero? not ; inline @@ -119,11 +119,11 @@ ERROR: no-vorbis-in-ogg ; #vorbis-headers>> 1 2 between? not ; inline : ?vorbis-error ( code -- ) - [ vorbis-error ] unless-zero ; inline + [ throw-vorbis-error ] unless-zero ; inline : get-remaining-vorbis-header-packet ( player -- ? ) [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout { - { [ dup 0 < ] [ vorbis-error ] } + { [ dup 0 < ] [ throw-vorbis-error ] } { [ dup zero? ] [ drop f ] } [ drop t ] } cond ; @@ -153,7 +153,7 @@ ERROR: no-vorbis-in-ogg ; : initialize-decoder ( vorbis-stream -- ) dup #vorbis-headers>> zero? - [ no-vorbis-in-ogg ] + [ throw-no-vorbis-in-ogg ] [ init-vorbis-codec ] if ; : get-pending-decoded-audio ( vorbis-stream -- pcm len ) diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor index a87a031e00..7dc686ea24 100644 --- a/extra/backtrack/backtrack.factor +++ b/extra/backtrack/backtrack.factor @@ -13,7 +13,7 @@ ERROR: amb-failure ; M: amb-failure summary drop "Backtracking failure" ; : fail ( -- ) - failure get [ continue ] [ amb-failure ] if* ; + failure get [ continue ] [ throw-amb-failure ] if* ; : must-be-true ( ? -- ) [ fail ] unless ; diff --git a/extra/base85/base85.factor b/extra/base85/base85.factor index fb8efb2e2c..e2d5f1cf6d 100644 --- a/extra/base85/base85.factor +++ b/extra/base85/base85.factor @@ -18,7 +18,7 @@ CONSTANT: alphabet : base85>ch ( ch -- ch ) $[ alphabet alphabet-inverse ] nth - [ malformed-base85 ] unless* ; inline + [ throw-malformed-base85 ] unless* ; inline : encode4 ( seq -- seq' ) be> 5 [ 85 /mod ch>base85 ] B{ } replicate-as reverse! nip ; inline @@ -48,7 +48,7 @@ PRIVATE> 5 "\n\r" pick read-ignoring dup length { { 0 [ 2drop ] } { 5 [ decode5 (decode-base85) ] } - [ malformed-base85 ] + [ throw-malformed-base85 ] } case ; PRIVATE> diff --git a/extra/benchmark/chameneos-redux/chameneos-redux.factor b/extra/benchmark/chameneos-redux/chameneos-redux.factor index bcc0e85620..83839398c9 100644 --- a/extra/benchmark/chameneos-redux/chameneos-redux.factor +++ b/extra/benchmark/chameneos-redux/chameneos-redux.factor @@ -38,7 +38,7 @@ TUPLE: meeting-place count mailbox ; { { yellow blue } [ red ] } { { blue red } [ yellow ] } { { blue yellow } [ red ] } - [ bad-color-pair ] + [ throw-bad-color-pair ] } case ] if ; diff --git a/extra/benchmark/tcp-echo0/tcp-echo0.factor b/extra/benchmark/tcp-echo0/tcp-echo0.factor index 60500b3aa8..05a7066bde 100644 --- a/extra/benchmark/tcp-echo0/tcp-echo0.factor +++ b/extra/benchmark/tcp-echo0/tcp-echo0.factor @@ -21,7 +21,7 @@ TUPLE: tcp-echo < threaded-server #times #bytes ; ERROR: incorrect-#bytes ; : check-bytes ( bytes n -- bytes ) - over length = [ incorrect-#bytes ] unless ; + over length = [ throw-incorrect-#bytes ] unless ; : read-n ( n -- bytes ) [ read ] [ check-bytes ] bi ; @@ -46,7 +46,7 @@ M: tcp-echo handle-client* [ \ threaded-server get server>address binary [ #times [ #bytes read-write ] times - contents empty? [ incorrect-#bytes ] unless + contents empty? [ throw-incorrect-#bytes ] unless ] with-client ] with-threaded-server ; diff --git a/extra/bit/ly/ly.factor b/extra/bit/ly/ly.factor index f69eff34b0..036ec55d40 100644 --- a/extra/bit/ly/ly.factor +++ b/extra/bit/ly/ly.factor @@ -19,7 +19,7 @@ ERROR: bad-response json status ; : check-status ( json -- json ) dup "status_code" of 200 = [ dup "status_txt" of - bad-response + throw-bad-response ] unless ; : json-data ( url -- json ) diff --git a/extra/bloom-filters/bloom-filters.factor b/extra/bloom-filters/bloom-filters.factor index 8dbdd3e24f..50a680919e 100644 --- a/extra/bloom-filters/bloom-filters.factor +++ b/extra/bloom-filters/bloom-filters.factor @@ -49,7 +49,7 @@ TUPLE: bloom-filter { capacity fixnum read-only } { count fixnum } ; -ERROR: invalid-size ; +ERROR: invalid-size size ; ERROR: invalid-error-rate error-rate ; ERROR: invalid-capacity capacity ; @@ -73,7 +73,7 @@ ERROR: invalid-capacity capacity ; ! If the number of hashes isn't positive, we haven't found ! anything smaller than the identity configuration. : check-hashes ( 2seq -- 2seq ) - dup first 0 <= [ invalid-size ] when ; + dup first 0 <= [ throw-invalid-size ] when ; ! The consensus on the tradeoff between increasing the number of ! bits and increasing the number of hash functions seems to be @@ -90,11 +90,11 @@ ERROR: invalid-capacity capacity ; ] reduce check-hashes first2 ; : check-capacity ( capacity -- capacity ) - dup 0 <= [ invalid-capacity ] when ; + dup 0 <= [ throw-invalid-capacity ] when ; : check-error-rate ( error-rate -- error-rate ) dup [ 0 after? ] [ 1 before? ] bi and - [ invalid-error-rate ] unless ; + [ throw-invalid-error-rate ] unless ; PRIVATE> diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index 62e76eb42c..cd00dbb03b 100644 --- a/extra/bson/reader/reader.factor +++ b/extra/bson/reader/reader.factor @@ -60,7 +60,7 @@ DEFER: read-elements { T_Binary_Function [ read-sized-string ] } { T_Binary_MD5 [ read >string ] } { T_Binary_UUID [ read >string ] } - [ "unknown binary sub-type" unknown-bson-type ] + [ "unknown binary sub-type" throw-unknown-bson-type ] } case ; inline TYPED: bson-regexp-read ( -- mdbregexp: mdbregexp ) @@ -90,7 +90,7 @@ TYPED: element-data-read ( type: integer -- object ) { T_Code [ read-int32 read-sized-string ] } { T_ScopedCode [ read-int32 drop read-cstring H{ } clone stream>assoc ] } { T_NULL [ f ] } - [ "type unknown" unknown-bson-type ] + [ "type unknown" throw-unknown-bson-type ] } case ; inline recursive TYPED: (read-object) ( type: integer name: string -- ) diff --git a/extra/c/preprocessor/preprocessor.factor b/extra/c/preprocessor/preprocessor.factor index 55e11edde5..c5232240fe 100644 --- a/extra/c/preprocessor/preprocessor.factor +++ b/extra/c/preprocessor/preprocessor.factor @@ -81,7 +81,7 @@ ERROR: header-file-missing path ; skip-whitespace/comments advance dup previous { { CHAR: < [ CHAR: > take-until-object read-standard-include ] } { CHAR: " [ CHAR: " take-until-object read-local-include ] } - [ bad-include-line ] + [ throw-bad-include-line ] } case ; : (readlns) ( -- ) @@ -155,7 +155,7 @@ ERROR: header-file-missing path ; { "else" [ handle-else ] } { "pragma" [ handle-pragma ] } { "include_next" [ handle-include-next ] } - [ unknown-c-preprocessor ] + [ throw-unknown-c-preprocessor ] } case ; : parse-directive-line ( preprocessor-state sequence-parser -- ) diff --git a/extra/cairo-demo/cairo-demo.factor b/extra/cairo-demo/cairo-demo.factor index b08729b7a1..30efcebb24 100644 --- a/extra/cairo-demo/cairo-demo.factor +++ b/extra/cairo-demo/cairo-demo.factor @@ -44,7 +44,7 @@ ERROR: no-cairo-t ; > [ no-cairo-t ] unless* + cairo-t>> [ throw-no-cairo-t ] unless* { [ "Sans" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_BOLD diff --git a/extra/constructors/constructors.factor b/extra/constructors/constructors.factor index 49d9d5098c..700f5bf38a 100644 --- a/extra/constructors/constructors.factor +++ b/extra/constructors/constructors.factor @@ -26,9 +26,9 @@ ERROR: repeated-constructor-parameters class effect ; ERROR: unknown-constructor-parameters class effect unknown ; : ensure-constructor-parameters ( class effect -- class effect ) - dup in>> all-unique? [ repeated-constructor-parameters ] unless + dup in>> all-unique? [ throw-repeated-constructor-parameters ] unless 2dup [ all-slots [ name>> ] map ] [ in>> ] bi* swap diff - [ unknown-constructor-parameters ] unless-empty ; + [ throw-unknown-constructor-parameters ] unless-empty ; : constructor-boa-quot ( constructor-word class effect -- word quot ) in>> swap '[ _ _ slots>boa ] ; inline diff --git a/extra/cpu/8080/emulator/emulator.factor b/extra/cpu/8080/emulator/emulator.factor index 1d48355f04..7cf1bb7b5e 100644 --- a/extra/cpu/8080/emulator/emulator.factor +++ b/extra/cpu/8080/emulator/emulator.factor @@ -488,7 +488,7 @@ ERROR: undefined-8080-opcode n ; dup instruction-cycles nth [ nip ] [ - undefined-8080-opcode + throw-undefined-8080-opcode ] if* ; : process-interrupts ( cpu -- ) diff --git a/extra/crypto/aes/aes.factor b/extra/crypto/aes/aes.factor index 5861cf2fc1..1b1323b131 100644 --- a/extra/crypto/aes/aes.factor +++ b/extra/crypto/aes/aes.factor @@ -147,9 +147,9 @@ SINGLETON: aes-256-key M: aes-128-key key-expand-round ( temp i -- temp' ) 4 /mod 0 = swap and [ (add-rcon) ] when* ; -ERROR: aes-192-256-not-implemented* ; +ERROR: aes-192-256-not-implemented ; M: aes-256-key key-expand-round ( temp i -- temp' ) - aes-192-256-not-implemented* ; + throw-aes-192-256-not-implemented ; : (key-sched-round) ( output temp i -- output' ) key-expand-round diff --git a/extra/crypto/xor/xor.factor b/extra/crypto/xor/xor.factor index 45bbe55d6e..bfeaf9af97 100644 --- a/extra/crypto/xor/xor.factor +++ b/extra/crypto/xor/xor.factor @@ -8,5 +8,5 @@ IN: crypto.xor ERROR: empty-xor-key ; : xor-crypt ( seq key -- seq' ) - [ empty-xor-key ] when-empty + [ throw-empty-xor-key ] when-empty [ dup length iota ] dip '[ _ mod-nth bitxor ] 2map ; diff --git a/extra/cuda/cuda.factor b/extra/cuda/cuda.factor index 9ecaebce29..54ae4a24ab 100644 --- a/extra/cuda/cuda.factor +++ b/extra/cuda/cuda.factor @@ -13,7 +13,7 @@ IN: cuda ERROR: cuda-error-state code ; : cuda-error ( code -- ) - dup CUDA_SUCCESS = [ drop ] [ cuda-error-state ] if ; + dup CUDA_SUCCESS = [ drop ] [ throw-cuda-error-state ] if ; : cuda-version ( -- n ) { c:int } [ cuDriverGetVersion cuda-error ] with-out-parameters ; diff --git a/extra/cuda/libraries/libraries.factor b/extra/cuda/libraries/libraries.factor index f899d4430d..fdf0799aa6 100644 --- a/extra/cuda/libraries/libraries.factor +++ b/extra/cuda/libraries/libraries.factor @@ -86,10 +86,10 @@ PRIVATE> ERROR: no-cuda-library name ; : lookup-cuda-library ( name -- cuda-library ) - cuda-libraries get ?at [ no-cuda-library ] unless ; + cuda-libraries get ?at [ throw-no-cuda-library ] unless ; : remove-cuda-library ( name -- library ) - cuda-libraries get ?delete-at [ no-cuda-library ] unless ; + cuda-libraries get ?delete-at [ throw-no-cuda-library ] unless ; : unload-cuda-library ( name -- ) remove-cuda-library handle>> unload-module ; @@ -189,7 +189,7 @@ TUPLE: cuda-library name abi path handle ; ERROR: bad-cuda-abi abi ; : check-cuda-abi ( abi -- abi ) - dup cuda-abi? [ bad-cuda-abi ] unless ; inline + dup cuda-abi? [ throw-bad-cuda-abi ] unless ; inline : ( name abi path -- obj ) \ cuda-library new diff --git a/extra/cuda/nvcc/nvcc.factor b/extra/cuda/nvcc/nvcc.factor index c1e35c32ca..443ff21363 100644 --- a/extra/cuda/nvcc/nvcc.factor +++ b/extra/cuda/nvcc/nvcc.factor @@ -26,6 +26,6 @@ ERROR: nvcc-failed n path ; path normalize-path :> path2 path2 parent-directory [ path2 nvcc-command - run-process wait-for-process [ path2 nvcc-failed ] unless-zero + run-process wait-for-process [ path2 throw-nvcc-failed ] unless-zero path2 cu>ptx ] with-directory ; diff --git a/extra/cuesheet/cuesheet.factor b/extra/cuesheet/cuesheet.factor index 4b85060a84..b5bd8dbfc7 100644 --- a/extra/cuesheet/cuesheet.factor +++ b/extra/cuesheet/cuesheet.factor @@ -31,7 +31,7 @@ ERROR: unknown-filetype filetype ; : check-filetype ( filetype -- filetype ) dup { "BINARY" "MOTOROLA" "AIFF" "WAVE" "MP3" } member? - [ unknown-filetype ] unless ; + [ throw-unknown-filetype ] unless ; ERROR: unknown-flag flag ; diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index a6629650ad..c089cea91f 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -179,8 +179,8 @@ ERROR: unsupported-curses-terminal ; : >BOOLEAN ( ? -- TRUE/FALSE ) ffi:TRUE ffi:FALSE ? ; inline : curses-pointer-error ( ptr/f -- ptr ) - [ curses-failed ] unless* ; inline -: curses-error ( n -- ) ffi:ERR = [ curses-failed ] when ; + [ throw-curses-failed ] unless* ; inline +: curses-error ( n -- ) ffi:ERR = [ throw-curses-failed ] when ; PRIVATE> @@ -262,7 +262,7 @@ PRIVATE> [ current-window ] dip with-variable ; inline : with-curses ( window quot -- ) - curses-ok? [ unsupported-curses-terminal ] unless + curses-ok? [ throw-unsupported-curses-terminal ] unless [ '[ ffi:initscr curses-pointer-error diff --git a/extra/cursors/cursors.factor b/extra/cursors/cursors.factor index 7efa7cca2d..b552ff1360 100644 --- a/extra/cursors/cursors.factor +++ b/extra/cursors/cursors.factor @@ -67,7 +67,9 @@ GENERIC: cursor-key-value-unsafe ( cursor -- key value ) PRIVATE> M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline M: input-cursor cursor-key-value - dup cursor-valid? [ cursor-key-value-unsafe ] [ invalid-cursor ] if ; inline + dup cursor-valid? + [ cursor-key-value-unsafe ] + [ throw-invalid-cursor ] if ; inline : cursor-key ( cursor -- key ) cursor-key-value drop ; : cursor-value ( cursor -- key ) cursor-key-value nip ; @@ -87,7 +89,9 @@ GENERIC: set-cursor-value-unsafe ( value cursor -- ) PRIVATE> M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline M: output-cursor set-cursor-value - dup cursor-valid? [ set-cursor-value-unsafe ] [ invalid-cursor ] if ; inline + dup cursor-valid? + [ set-cursor-value-unsafe ] + [ throw-invalid-cursor ] if ; inline ! ! stream cursors diff --git a/extra/decimals/decimals-tests.factor b/extra/decimals/decimals-tests.factor index 726212b0ea..fc48561e8c 100644 --- a/extra/decimals/decimals-tests.factor +++ b/extra/decimals/decimals-tests.factor @@ -21,7 +21,7 @@ ERROR: decimal-test-failure D1 D2 quot ; D1 D2 quot1 [ decimal>ratio >float ] compose [ [ decimal>ratio ] bi@ quot2 call( obj obj -- obj ) >float ] 2bi -.1 ~ - [ t ] [ D1 D2 quot1 decimal-test-failure ] if ; inline + [ t ] [ D1 D2 quot1 throw-decimal-test-failure ] if ; inline : test-decimal-op ( quot1 quot2 -- ? ) [ random-test-decimal random-test-decimal ] 2dip (test-decimal-op) ; inline diff --git a/extra/decimals/decimals.factor b/extra/decimals/decimals.factor index 1d244f0355..23fa3a273d 100644 --- a/extra/decimals/decimals.factor +++ b/extra/decimals/decimals.factor @@ -43,7 +43,7 @@ ERROR: decimal-types-expected d1 d2 ; : guard-decimals ( obj1 obj2 -- D1 D2 ) 2dup [ decimal? ] both? - [ decimal-types-expected ] unless ; + [ throw-decimal-types-expected ] unless ; M: decimal equal? { diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index 112540bc91..ccf29a02c3 100644 --- a/extra/descriptive/descriptive.factor +++ b/extra/descriptive/descriptive.factor @@ -19,7 +19,7 @@ M: descriptive-error error. : rethrower ( word inputs -- quot ) [ length ] keep [ [ narray ] dip swap 2array flip ] 2curry - [ 2 ndip descriptive-error ] 2curry ; + [ 2 ndip throw-descriptive-error ] 2curry ; : [descriptive] ( word def effect -- newdef ) swapd in>> rethrower [ recover ] 2curry ; diff --git a/extra/dns/dns.factor b/extra/dns/dns.factor index d8e3f6bdf7..917e1bcb2b 100644 --- a/extra/dns/dns.factor +++ b/extra/dns/dns.factor @@ -242,7 +242,7 @@ ERROR: unsupported-domain-name string ; : >n/label ( string -- byte-array ) dup [ ascii? ] all? - [ unsupported-domain-name ] unless + [ throw-unsupported-domain-name ] unless [ length 1array ] [ ] bi B{ } append-as ; : >name ( domain -- byte-array ) diff --git a/extra/forestdb/lib/lib.factor b/extra/forestdb/lib/lib.factor index f3ce44dc86..0f26a5bbbd 100644 --- a/extra/forestdb/lib/lib.factor +++ b/extra/forestdb/lib/lib.factor @@ -16,7 +16,7 @@ IN: forestdb.lib ERROR: fdb-error error ; : fdb-check-error ( ret -- ) - dup FDB_RESULT_SUCCESS = [ drop ] [ fdb-error ] if ; + dup FDB_RESULT_SUCCESS = [ drop ] [ throw-fdb-error ] if ; TUPLE: fdb-kvs-handle < disposable handle ; @@ -93,7 +93,7 @@ SYMBOL: current-fdb-kvs-handle rot { { FDB_RESULT_SUCCESS [ ret>string ] } { FDB_RESULT_KEY_NOT_FOUND [ 2drop f ] } - [ fdb-error ] + [ throw-fdb-error ] } case ; : fdb-del-kv ( key -- ) diff --git a/extra/forestdb/paths/paths.factor b/extra/forestdb/paths/paths.factor index d27af11e6a..79c54b12e0 100644 --- a/extra/forestdb/paths/paths.factor +++ b/extra/forestdb/paths/paths.factor @@ -18,12 +18,12 @@ CONSTANT: fdb-filename-base "fq" ERROR: not-an-fdb-filename string ; : ensure-fdb-filename ( string -- string ) - dup fdb-filename? [ not-an-fdb-filename ] unless ; + dup fdb-filename? [ throw-not-an-fdb-filename ] unless ; ERROR: not-a-string-number string ; : ?string>number ( string -- n ) - dup string>number dup [ nip ] [ not-a-string-number ] if ; + dup string>number dup [ nip ] [ throw-not-a-string-number ] if ; : change-string-number ( string quot -- string' ) [ [ string>number ] dip call number>string ] 2keep drop diff --git a/extra/fullscreen/fullscreen.factor b/extra/fullscreen/fullscreen.factor index 7b30d25f0e..fe4535957b 100755 --- a/extra/fullscreen/fullscreen.factor +++ b/extra/fullscreen/fullscreen.factor @@ -55,12 +55,12 @@ ERROR: display-change-error n ; : fullscreen-mode ( monitor-info devmode -- ) [ szDevice>> ] dip f CDS_FULLSCREEN f ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL = - [ drop ] [ display-change-error ] if ; + [ drop ] [ throw-display-change-error ] if ; : non-fullscreen-mode ( monitor-info devmode -- ) [ szDevice>> ] dip f 0 f ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL = - [ drop ] [ display-change-error ] if ; + [ drop ] [ throw-display-change-error ] if ; : get-style ( hwnd n -- style ) GetWindowLongPtr [ win32-error=0/f ] keep ; @@ -86,7 +86,7 @@ ERROR: unsupported-resolution triple ; [ slots{ dmPelsWidth dmPelsHeight dmBitsPerPel } triple = - ] find nip [ triple unsupported-resolution ] unless* ; + ] find nip [ triple throw-unsupported-resolution ] unless* ; :: set-fullscreen-window-position ( hwnd triple -- ) hwnd f diff --git a/extra/game/models/collada/collada.factor b/extra/game/models/collada/collada.factor index 18773e79a4..3342aceedd 100644 --- a/extra/game/models/collada/collada.factor +++ b/extra/game/models/collada/collada.factor @@ -24,12 +24,12 @@ SYMBOLS: up-axis unit-ratio ; : x/ ( tag child-name -- child-tag ) [ tag-named ] - [ rot dup [ drop missing-child ] unless 2nip ] + [ rot dup [ drop throw-missing-child ] unless 2nip ] 2bi ; inline : x@ ( tag attr-name -- attr-value ) [ attr ] - [ rot dup [ drop missing-attr ] unless 2nip ] + [ rot dup [ drop throw-missing-attr ] unless 2nip ] 2bi ; inline : xt ( tag -- content ) children>string ; diff --git a/extra/game/models/loader/loader.factor b/extra/game/models/loader/loader.factor index d566c512b1..73fa57af8a 100644 --- a/extra/game/models/loader/loader.factor +++ b/extra/game/models/loader/loader.factor @@ -15,11 +15,11 @@ types [ H{ } clone ] initialize : models-class ( path -- class ) file-extension >lower types get ?at - [ unknown-models-extension ] unless second ; + [ throw-unknown-models-extension ] unless second ; : models-encoding ( path -- encoding ) file-extension >lower types get ?at - [ unknown-models-extension ] unless first ; + [ throw-unknown-models-extension ] unless first ; : open-models-file ( path encoding -- stream ) ; diff --git a/extra/gopher/gopher.factor b/extra/gopher/gopher.factor index 32d81cf378..96d27c99fd 100644 --- a/extra/gopher/gopher.factor +++ b/extra/gopher/gopher.factor @@ -53,7 +53,7 @@ ERROR: not-a-gopher-url url ; : gopher ( url -- item-type byte-array ) dup url? [ >url ] unless - dup protocol>> "gopher" = [ not-a-gopher-url ] unless { + dup protocol>> "gopher" = [ throw-not-a-gopher-url ] unless { [ host>> ] [ port>> 70 or binary ] [ path>> rest [ "1/" ] when-empty ] diff --git a/extra/gpu/render/render.factor b/extra/gpu/render/render.factor index f157e322a8..312559e0de 100755 --- a/extra/gpu/render/render.factor +++ b/extra/gpu/render/render.factor @@ -399,7 +399,7 @@ DEFER: [bind-uniform-tuple] { mat4-uniform { [ dim 0 ] dip 4 4 >uniform-matrix-array glUniformMatrix4fv } } { texture-uniform { drop dim dup iota [ texture-unit + ] int-array{ } map-as glUniform1iv } } - } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform throw-invalid-uniform-type ] unless* >quotation :> value-quot type uniform-type-texture-units dim * texture-unit + pre-quot value-quot append ; @@ -442,7 +442,7 @@ DEFER: [bind-uniform-tuple] { mat4-uniform [ [ 1 0 ] dip 4 4 >uniform-matrix glUniformMatrix4fv ] } { texture-uniform { drop texture-unit glUniform1i } } - } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform throw-invalid-uniform-type ] unless* >quotation :> value-quot type uniform-type-texture-units texture-unit + pre-quot value-quot append ; diff --git a/extra/gpu/shaders/shaders.factor b/extra/gpu/shaders/shaders.factor index 559f46f560..a1f514e246 100755 --- a/extra/gpu/shaders/shaders.factor +++ b/extra/gpu/shaders/shaders.factor @@ -139,7 +139,7 @@ TR: hyphens>underscores "-" "_" ; [ vertex-attribute name>> name = ] [ size 1 = ] [ gl-type vertex-attribute [ component-type>> ] [ dim>> ] bi feedback-type= ] - } 0&& [ vertex-attribute inaccurate-feedback-attribute-error ] unless ; + } 0&& [ vertex-attribute throw-inaccurate-feedback-attribute-error ] unless ; :: (bind-float-vertex-attribute) ( program-instance ptr name dim gl-type normalize? stride offset -- ) program-instance name attribute-index :> idx @@ -182,7 +182,7 @@ TR: hyphens>underscores "-" "_" ; :: [link-feedback-format] ( vertex-attributes -- quot ) vertex-attributes [ name>> not ] any? - [ [ nip invalid-link-feedback-format-error ] ] [ + [ [ nip throw-invalid-link-feedback-format-error ] ] [ vertex-attributes [ name>> ascii malloc-string ] void*-array{ } map-as :> varying-names @@ -529,7 +529,7 @@ TUPLE: feedback-format : validate-feedback-format ( sequence -- vertex-format/f ) dup length 1 <= [ [ f ] [ first vertex-format>> ] if-empty ] - [ too-many-feedback-formats-error ] if ; + [ throw-too-many-feedback-formats-error ] if ; : ?shader ( object -- shader/f ) dup word? [ def>> first dup shader? [ drop f ] unless ] [ drop f ] if ; diff --git a/extra/graphviz/render/render.factor b/extra/graphviz/render/render.factor index 6caf5250ee..b95f554838 100644 --- a/extra/graphviz/render/render.factor +++ b/extra/graphviz/render/render.factor @@ -112,7 +112,7 @@ PRIVATE> { "png" [ ".png" ] } { "tif" [ ".tif" ] } { "tiff" [ ".tif" ] } - [ unsupported-preview-format ] + [ throw-unsupported-preview-format ] } case ; :: with-preview ( graph quot: ( path -- ) -- ) diff --git a/extra/html/parser/analyzer/analyzer.factor b/extra/html/parser/analyzer/analyzer.factor index e48f09d660..e8721c8785 100644 --- a/extra/html/parser/analyzer/analyzer.factor +++ b/extra/html/parser/analyzer/analyzer.factor @@ -36,7 +36,7 @@ IN: html.parser.analyzer ERROR: undefined-find-nth m n seq quot ; : check-trivial-find ( m n seq quot -- m n seq quot ) - pick 0 = [ undefined-find-nth ] when ; inline + pick 0 = [ throw-undefined-find-nth ] when ; inline : find-nth-from ( m n seq quot -- i/f elt/f ) check-trivial-find [ f ] 3dip '[ diff --git a/extra/images/atlas/atlas.factor b/extra/images/atlas/atlas.factor index 8d03207cd5..f17a5975f9 100644 --- a/extra/images/atlas/atlas.factor +++ b/extra/images/atlas/atlas.factor @@ -56,7 +56,7 @@ ERROR: atlas-image-formats-dont-match images ; [ [ upside-down?>> ] same? ] 2tri and and ] all? [ first [ component-order>> ] [ component-type>> ] [ upside-down?>> ] tri ] - [ atlas-image-formats-dont-match ] if ; inline + [ throw-atlas-image-formats-dont-match ] if ; inline : atlas-dim ( image-placements -- dim ) [ [ loc>> ] [ image>> dim>> ] bi v+ atlas-padding v+n ] [ vmax ] map-reduce diff --git a/extra/images/bitmap/bitmap.factor b/extra/images/bitmap/bitmap.factor index 2ac2326e32..61697207cf 100644 --- a/extra/images/bitmap/bitmap.factor +++ b/extra/images/bitmap/bitmap.factor @@ -182,7 +182,7 @@ UNION: os2-header os2v1-header os2v2-header ; { 40 [ read-v3-header ] } { 108 [ read-v4-header ] } { 124 [ read-v5-header ] } - [ unknown-bitmap-header ] + [ throw-unknown-bitmap-header ] } case ; : color-index-length ( header -- n ) @@ -228,7 +228,7 @@ GENERIC: bitmap>component-order* ( loading-bitmap header -- object ) { 8 [ BGR ] } { 4 [ BGR ] } { 1 [ BGR ] } - [ unknown-component-order ] + [ throw-unknown-component-order ] } case ; : advanced-bitmap>component-order ( loading-bitmap -- object ) diff --git a/extra/images/gif/gif.factor b/extra/images/gif/gif.factor index 13e0cc1ac6..5702a91d7a 100644 --- a/extra/images/gif/gif.factor +++ b/extra/images/gif/gif.factor @@ -126,7 +126,7 @@ CONSTANT: BLOCK-TERMINATOR 0x00 ERROR: unimplemented message ; : read-GIF87a ( loading-gif -- loading-gif ) - "GIF87a" unimplemented ; + "GIF87a" throw-unimplemented ; : read-logical-screen-descriptor ( loading-gif -- loading-gif ) 2 read le> >>width @@ -182,8 +182,8 @@ ERROR: unimplemented message ; { APPLICATION-EXTENSION [ read-application-extension over application-extensions>> push ] } - { f [ gif-unexpected-eof ] } - [ unknown-extension ] + { f [ throw-gif-unexpected-eof ] } + [ throw-unknown-extension ] } case ; ERROR: unhandled-data byte ; @@ -197,7 +197,7 @@ ERROR: unhandled-data byte ; ] } { IMAGE-DESCRIPTOR [ read-table-based-image ] } { TRAILER [ f >>loading? ] } - [ unhandled-data ] + [ throw-unhandled-data ] } case ; : read-GIF89a ( loading-gif -- loading-gif ) @@ -211,7 +211,7 @@ ERROR: unhandled-data byte ; read-gif-header dup magic>> { { "GIF87a" [ read-GIF87a ] } { "GIF89a" [ read-GIF89a ] } - [ unsupported-gif-format ] + [ throw-unsupported-gif-format ] } case ] with-input-stream ; @@ -246,7 +246,7 @@ ERROR: unhandled-data byte ; ERROR: loading-gif-error gif-image ; : ensure-loaded ( gif-image -- gif-image ) - dup loading?>> [ loading-gif-error ] when ; + dup loading?>> [ throw-loading-gif-error ] when ; M: gif-image stream>image* ( path gif-image -- image ) drop load-gif ensure-loaded gif>image ; diff --git a/extra/images/png/png.factor b/extra/images/png/png.factor index ffd0a7a09d..611c0308ec 100644 --- a/extra/images/png/png.factor +++ b/extra/images/png/png.factor @@ -56,7 +56,7 @@ ERROR: bad-png-header header ; : read-png-header ( -- ) 8 read dup png-header sequence= [ - bad-png-header + throw-bad-png-header ] unless drop ; ERROR: bad-checksum ; diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor index c64f4907d8..f7b09cf341 100644 --- a/extra/images/tga/tga.factor +++ b/extra/images/tga/tga.factor @@ -20,11 +20,11 @@ ERROR: bad-tga-unsupported ; : read-color-map-type ( -- byte ) 1 read le> dup - { 0 1 } member? [ bad-tga-header ] unless ; + { 0 1 } member? [ throw-bad-tga-header ] unless ; : read-image-type ( -- byte ) 1 read le> dup - { 0 1 2 3 9 10 11 } member? [ bad-tga-header ] unless ; inline + { 0 1 2 3 9 10 11 } member? [ throw-bad-tga-header ] unless ; inline : read-color-map-first ( -- short ) 2 read le> ; inline @@ -70,10 +70,10 @@ ERROR: bad-tga-unsupported ; 4 read le> ; inline : read-signature ( -- ) - 18 read ascii decode "TRUEVISION-XFILE.\0" = [ bad-tga-footer ] unless ; inline + 18 read ascii decode "TRUEVISION-XFILE.\0" = [ throw-bad-tga-footer ] unless ; inline : read-extension-size ( -- ) - 2 read le> 495 = [ bad-tga-extension-size ] unless ; inline + 2 read le> 495 = [ throw-bad-tga-extension-size ] unless ; inline : read-author-name ( -- string ) 41 read ascii decode [ 0 = ] trim ; inline @@ -83,12 +83,12 @@ ERROR: bad-tga-unsupported ; : read-date-timestamp ( -- timestamp ) timestamp new - 2 read le> dup 12 [1,b] member? [ bad-tga-timestamp ] unless >>month - 2 read le> dup 31 [1,b] member? [ bad-tga-timestamp ] unless >>day + 2 read le> dup 12 [1,b] member? [ throw-bad-tga-timestamp ] unless >>month + 2 read le> dup 31 [1,b] member? [ throw-bad-tga-timestamp ] unless >>day 2 read le> >>year - 2 read le> dup 23 [0,b] member? [ bad-tga-timestamp ] unless >>hour - 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute - 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline + 2 read le> dup 23 [0,b] member? [ throw-bad-tga-timestamp ] unless >>hour + 2 read le> dup 59 [0,b] member? [ throw-bad-tga-timestamp ] unless >>minute + 2 read le> dup 59 [0,b] member? [ throw-bad-tga-timestamp ] unless >>second ; inline : read-job-name ( -- string ) 41 read ascii decode [ 0 = ] trim ; inline @@ -96,8 +96,8 @@ ERROR: bad-tga-unsupported ; : read-job-time ( -- duration ) duration new 2 read le> >>hour - 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>minute - 2 read le> dup 59 [0,b] member? [ bad-tga-timestamp ] unless >>second ; inline + 2 read le> dup 59 [0,b] member? [ throw-bad-tga-timestamp ] unless >>minute + 2 read le> dup 59 [0,b] member? [ throw-bad-tga-timestamp ] unless >>second ; inline : read-software-id ( -- string ) 41 read ascii decode [ 0 = ] trim ; inline @@ -240,10 +240,10 @@ ERROR: bad-tga-unsupported ; #! Only 24-bit uncompressed BGR and 32-bit uncompressed BGRA are supported. #! Other formats would need to be converted to work within the image class. - map-type 0 = [ bad-tga-unsupported ] unless - image-type 2 = [ bad-tga-unsupported ] unless - pixel-depth { 24 32 } member? [ bad-tga-unsupported ] unless - pixel-order { 0 2 } member? [ bad-tga-unsupported ] unless + map-type 0 = [ throw-bad-tga-unsupported ] unless + image-type 2 = [ throw-bad-tga-unsupported ] unless + pixel-depth { 24 32 } member? [ throw-bad-tga-unsupported ] unless + pixel-order { 0 2 } member? [ throw-bad-tga-unsupported ] unless #! Create image instance image new @@ -259,7 +259,7 @@ M: tga-image stream>image* M: tga-image image>stream 2drop [ - component-order>> { BGRA BGRA } member? [ bad-tga-unsupported ] unless + component-order>> { BGRA BGRA } member? [ throw-bad-tga-unsupported ] unless ] keep B{ 0 } write #! id-length diff --git a/extra/images/tiff/tiff.factor b/extra/images/tiff/tiff.factor index aee3d747d9..c9343396b8 100755 --- a/extra/images/tiff/tiff.factor +++ b/extra/images/tiff/tiff.factor @@ -65,7 +65,7 @@ ERROR: bad-photometric-interpretation n ; { 10 [ photometric-interpretation-itulab ] } { 32844 [ photometric-interpretation-logl ] } { 32845 [ photometric-interpretation-logluv ] } - [ bad-photometric-interpretation ] + [ throw-bad-photometric-interpretation ] } case ; SINGLETONS: compression @@ -124,7 +124,7 @@ ERROR: bad-compression n ; { 34676 [ compression-sgilog ] } { 34677 [ compression-sgilog24 ] } { 34712 [ compression-jp2000 ] } - [ bad-compression ] + [ throw-bad-compression ] } case ; SINGLETONS: resolution-unit @@ -137,7 +137,7 @@ ERROR: bad-resolution-unit n ; { 1 [ resolution-unit-none ] } { 2 [ resolution-unit-inch ] } { 3 [ resolution-unit-centimeter ] } - [ bad-resolution-unit ] + [ throw-bad-resolution-unit ] } case ; SINGLETONS: predictor @@ -148,7 +148,7 @@ ERROR: bad-predictor n ; { { 1 [ predictor-none ] } { 2 [ predictor-horizontal-differencing ] } - [ bad-predictor ] + [ throw-bad-predictor ] } case ; SINGLETONS: planar-configuration @@ -159,7 +159,7 @@ ERROR: bad-planar-configuration n ; { { 1 [ planar-configuration-chunky ] } { 2 [ planar-configuration-planar ] } - [ bad-planar-configuration ] + [ throw-bad-planar-configuration ] } case ; SINGLETONS: sample-format @@ -177,7 +177,7 @@ ERROR: bad-sample-format n ; { 2 [ sample-format-signed-integer ] } { 3 [ sample-format-ieee-float ] } { 4 [ sample-format-undefined-data ] } - [ bad-sample-format ] + [ throw-bad-sample-format ] } case ] map ; @@ -191,7 +191,7 @@ ERROR: bad-extra-samples n ; { 0 [ extra-samples-unspecified-alpha-data ] } { 1 [ extra-samples-associated-alpha-data ] } { 2 [ extra-samples-unassociated-alpha-data ] } - [ bad-extra-samples ] + [ throw-bad-extra-samples ] } case ; SINGLETONS: image-length image-width x-resolution y-resolution @@ -224,7 +224,7 @@ ERROR: bad-jpeg-proc n ; { { 1 [ jpeg-proc-baseline ] } { 14 [ jpeg-proc-lossless ] } - [ bad-jpeg-proc ] + [ throw-bad-jpeg-proc ] } case ; ERROR: bad-tiff-magic bytes ; @@ -232,7 +232,7 @@ ERROR: bad-tiff-magic bytes ; { { B{ CHAR: M CHAR: M } [ big-endian ] } { B{ CHAR: I CHAR: I } [ little-endian ] } - [ bad-tiff-magic ] + [ throw-bad-tiff-magic ] } case ; : read-header ( tiff -- tiff ) @@ -277,7 +277,7 @@ ERROR: no-tag class ; swap processed-tags>> ?at ; : find-tag ( ifd class -- tag ) - find-tag* [ no-tag ] unless ; + find-tag* [ throw-no-tag ] unless ; : tag? ( ifd class -- tag ) swap processed-tags>> key? ; @@ -314,7 +314,7 @@ ERROR: unknown-ifd-type n where ; { 11 [ 4 * ] } { 12 [ 8 * ] } { 13 [ 4 * ] } - [ "value-length" unknown-ifd-type ] + [ "value-length" throw-unknown-ifd-type ] } case ; ERROR: bad-small-ifd-type n ; @@ -330,7 +330,7 @@ ERROR: bad-small-ifd-type n ; { 9 [ endian> 32 >signed ] } { 11 [ endian> bits>float ] } { 13 [ endian> 32 >signed ] } - [ bad-small-ifd-type ] + [ throw-bad-small-ifd-type ] } case ; : offset-bytes>obj ( bytes type -- obj ) @@ -347,7 +347,7 @@ ERROR: bad-small-ifd-type n ; { 10 [ 8 group [ "ii" unpack first2 / ] map ] } { 11 [ 4 group [ "f" unpack ] map ] } { 12 [ 8 group [ "d" unpack ] map ] } - [ "offset-bytes>obj" unknown-ifd-type ] + [ "offset-bytes>obj" throw-unknown-ifd-type ] } case ; : ifd-entry-value ( ifd-entry -- n ) @@ -455,7 +455,7 @@ ERROR: unhandled-compression compression ; { { compression-none [ ] } { compression-lzw [ [ tiff-lzw-uncompress ] map ] } - [ unhandled-compression ] + [ throw-unhandled-compression ] } case ; : uncompress-strips ( ifd -- ifd ) @@ -483,7 +483,7 @@ ERROR: unhandled-compression compression ; { { predictor-none [ ] } { predictor-horizontal-differencing [ (strips-predictor) ] } - [ bad-predictor ] + [ throw-bad-predictor ] } case ] when ; @@ -499,7 +499,7 @@ ERROR: unknown-component-order ifd ; { { 8 8 8 8 } [ ] } { { 8 8 8 } [ ] } { 8 [ ] } - [ unknown-component-order ] + [ throw-unknown-component-order ] } case >>bitmap ; : ifd-component-order ( ifd -- component-order component-type ) @@ -511,7 +511,7 @@ ERROR: unknown-component-order ifd ; { { 8 8 8 8 } [ RGBA ubyte-components ] } { { 8 8 8 } [ RGB ubyte-components ] } { 8 [ LA ubyte-components ] } - [ unknown-component-order ] + [ throw-unknown-component-order ] } case ; : handle-alpha-data ( ifd -- ifd ) @@ -519,7 +519,7 @@ ERROR: unknown-component-order ifd ; { extra-samples-associated-alpha-data [ ] } { extra-samples-unspecified-alpha-data [ ] } { extra-samples-unassociated-alpha-data [ ] } - [ bad-extra-samples ] + [ throw-bad-extra-samples ] } case ; : ifd>image ( ifd -- image ) diff --git a/extra/imap/imap-tests.factor b/extra/imap/imap-tests.factor index d79270cb56..511c2fa3f2 100644 --- a/extra/imap/imap-tests.factor +++ b/extra/imap/imap-tests.factor @@ -29,7 +29,7 @@ IN: imap.tests ERROR: no-imap-test-host ; : get-test-host ( -- host ) - \ imap-settings get-global host>> [ no-imap-test-host ] unless* ; + \ imap-settings get-global host>> [ throw-no-imap-test-host ] unless* ; : imap-test ( result quot -- ) '[ \ imap-settings get-global _ with-imap-settings ] unit-test ; inline diff --git a/extra/imap/imap.factor b/extra/imap/imap.factor index 2436af9b32..77d7a0c736 100644 --- a/extra/imap/imap.factor +++ b/extra/imap/imap.factor @@ -41,7 +41,7 @@ CONSTANT: IMAP4_SSL_PORT 993 [ number>string ] map "," join ; : check-status ( ind data -- ) - over "OK" = not [ imap4-error ] [ 2drop ] if ; + over "OK" = not [ throw-imap4-error ] [ 2drop ] if ; : read-response-chunk ( stop-expr -- item ? ) read-?crlf ascii decode swap dupd pcre:findall diff --git a/extra/infix/infix.factor b/extra/infix/infix.factor index 45ea18b128..83611aaa77 100644 --- a/extra/infix/infix.factor +++ b/extra/infix/infix.factor @@ -16,7 +16,7 @@ M: local-not-defined summary : >local-word ( string -- word ) qualified-vocabs last words>> ?at - [ local-not-defined ] unless ; + [ throw-local-not-defined ] unless ; ERROR: invalid-op string ; @@ -28,7 +28,7 @@ ERROR: invalid-op string ; { "/" [ [ / ] ] } { "%" [ [ mod ] ] } { "**" [ [ ^ ] ] } - [ invalid-op ] + [ throw-invalid-op ] } case ; GENERIC: infix-codegen ( ast -- quot/number ) diff --git a/extra/io/binary/fast/fast.factor b/extra/io/binary/fast/fast.factor index 64206a7cd5..13a9f1df02 100644 --- a/extra/io/binary/fast/fast.factor +++ b/extra/io/binary/fast/fast.factor @@ -14,7 +14,7 @@ IN: io.binary.fast ERROR: bad-length bytes n ; : check-length ( bytes n -- bytes n ) - 2dup [ length ] dip > [ bad-length ] when ; inline + 2dup [ length ] dip > [ throw-bad-length ] when ; inline << : be-range ( n -- range ) diff --git a/extra/io/files/acls/macosx/ffi/ffi.factor b/extra/io/files/acls/macosx/ffi/ffi.factor index 38a2a003f6..c757d3c40e 100644 --- a/extra/io/files/acls/macosx/ffi/ffi.factor +++ b/extra/io/files/acls/macosx/ffi/ffi.factor @@ -77,7 +77,7 @@ CONSTANT: ACL_EXTENDED_DENY 2 ERROR: bad-acl-tag-t n ; : acl_tag_t>string ( n -- string ) - dup 0 2 between? [ bad-acl-tag-t ] unless + dup 0 2 between? [ throw-bad-acl-tag-t ] unless { "undefined" "allow" "deny" } nth ; ! acl_flag_t diff --git a/extra/io/files/acls/macosx/macosx.factor b/extra/io/files/acls/macosx/macosx.factor index c26be9572c..247e52b98e 100644 --- a/extra/io/files/acls/macosx/macosx.factor +++ b/extra/io/files/acls/macosx/macosx.factor @@ -77,7 +77,7 @@ PRIVATE> ERROR: acl-init-failed n ; :: n>new-acl ( n -- acl ) - n acl_init dup [ n acl-init-failed ] unless ; + n acl_init dup [ n throw-acl-init-failed ] unless ; : new-acl ( -- acl ) 1 n>new-acl ; inline diff --git a/extra/io/streams/zeros/zeros.factor b/extra/io/streams/zeros/zeros.factor index 2077c64610..bc6c7c5ffe 100644 --- a/extra/io/streams/zeros/zeros.factor +++ b/extra/io/streams/zeros/zeros.factor @@ -33,7 +33,7 @@ ERROR: invalid-file-size n path ; : zero-file ( n path -- ) { - { [ over 0 < ] [ invalid-file-size ] } + { [ over 0 < ] [ throw-invalid-file-size ] } { [ over 0 = ] [ nip touch-file ] } [ (zero-file) ] } cond ; diff --git a/extra/ip-parser/ip-parser.factor b/extra/ip-parser/ip-parser.factor index 5dc03fae72..558402df94 100644 --- a/extra/ip-parser/ip-parser.factor +++ b/extra/ip-parser/ip-parser.factor @@ -28,7 +28,7 @@ ERROR: invalid-ipv4 str ; { 2 [ 1 cut { 0 0 } glue ] } { 3 [ 2 cut { 0 } glue ] } { 4 [ ] } - [ drop invalid-ipv4 ] + [ drop throw-invalid-ipv4 ] } case bubble nip ; inline PRIVATE> diff --git a/extra/machine-learning/rebalancing/rebalancing.factor b/extra/machine-learning/rebalancing/rebalancing.factor index 41c3296eee..df9c19beb8 100644 --- a/extra/machine-learning/rebalancing/rebalancing.factor +++ b/extra/machine-learning/rebalancing/rebalancing.factor @@ -7,7 +7,7 @@ IN: machine-learning.rebalancing ERROR: probability-sum-not-one seq ; : check-probabilities ( seq -- seq ) - dup sum 1.0 .00000000001 ~ [ probability-sum-not-one ] unless ; + dup sum 1.0 .00000000001 ~ [ throw-probability-sum-not-one ] unless ; : equal-probabilities ( n -- array ) dup recip ; inline diff --git a/extra/macho/macho.factor b/extra/macho/macho.factor index 65157c7914..2388c42ff7 100644 --- a/extra/macho/macho.factor +++ b/extra/macho/macho.factor @@ -833,7 +833,7 @@ ERROR: not-fat-binary ; fat_header memory>struct dup magic>> { { FAT_MAGIC [ ] } { FAT_CIGAM [ ] } - [ 2drop not-fat-binary ] + [ 2drop throw-not-fat-binary ] } case dup [ >c-ptr fat_header heap-size swap ] [ nfat_arch>> 4 >be le> ] bi diff --git a/extra/managed-server/managed-server.factor b/extra/managed-server/managed-server.factor index b7a73c4832..3a0b4ad774 100644 --- a/extra/managed-server/managed-server.factor +++ b/extra/managed-server/managed-server.factor @@ -21,7 +21,7 @@ HOOK: handle-client-disconnect managed-server ( -- ) ERROR: already-logged-in username ; -M: managed-server handle-already-logged-in already-logged-in ; +M: managed-server handle-already-logged-in throw-already-logged-in ; M: managed-server handle-client-join ; M: managed-server handle-client-disconnect ; @@ -44,7 +44,7 @@ ERROR: no-such-client username ; PRIVATE> : send-client ( seq username -- ) - clients ?at [ no-such-client ] [ (send-client) ] if ; + clients ?at [ throw-no-such-client ] [ (send-client) ] if ; : send-everyone ( seq -- ) [ client-streams ] dip '[ _ (send-client) ] each ; diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index d01dff72d5..2bfda23a75 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -13,7 +13,7 @@ IN: mason.common ERROR: no-host-name ; : short-host-name ( -- string ) - host-name "." split1 drop [ no-host-name ] unless* ; + host-name "." split1 drop [ throw-no-host-name ] unless* ; SYMBOL: current-git-id diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index 9d74bdc750..29465ffd1a 100644 --- a/extra/math/derivatives/derivatives.factor +++ b/extra/math/derivatives/derivatives.factor @@ -23,7 +23,7 @@ DERIVATIVE: abs [ 0 <=> { { +lt+ [ neg ] } - { +eq+ [ 0 \ abs undefined-derivative ] } + { +eq+ [ 0 \ abs throw-undefined-derivative ] } { +gt+ [ ] } } case ] ; diff --git a/extra/math/matrices/laplace/laplace.factor b/extra/math/matrices/laplace/laplace.factor index 817fa89d9a..86b12231e1 100644 --- a/extra/math/matrices/laplace/laplace.factor +++ b/extra/math/matrices/laplace/laplace.factor @@ -32,7 +32,7 @@ INSTANCE: missing immutable-sequence ERROR: not-a-square-matrix matrix ; : check-square-matrix ( matrix -- matrix ) - dup square-matrix? [ not-a-square-matrix ] unless ; inline + dup square-matrix? [ throw-not-a-square-matrix ] unless ; inline PRIVATE> diff --git a/extra/math/transforms/fft/fft.factor b/extra/math/transforms/fft/fft.factor index b887b55a53..d7cdfe47c2 100644 --- a/extra/math/transforms/fft/fft.factor +++ b/extra/math/transforms/fft/fft.factor @@ -39,10 +39,10 @@ PRIVATE> ERROR: not-enough-data ; : fft ( seq -- seq' ) - [ not-enough-data ] [ f (fft) ] if-empty ; + [ throw-not-enough-data ] [ f (fft) ] if-empty ; : ifft ( seq -- seq' ) - [ not-enough-data ] [ t (fft) ] if-empty ; + [ throw-not-enough-data ] [ t (fft) ] if-empty ; : correlate ( x y -- z ) [ fft ] [ reverse fft ] bi* v* ifft ; diff --git a/extra/memcached/memcached.factor b/extra/memcached/memcached.factor index 8ff2a03de3..5561fdad9c 100644 --- a/extra/memcached/memcached.factor +++ b/extra/memcached/memcached.factor @@ -112,14 +112,14 @@ TUPLE: request cmd key val extra opaque cas ; : check-status ( header -- ) [ 5 ] dip nth { - { NOT_FOUND [ key-not-found ] } - { EXISTS [ key-exists ] } - { TOO_LARGE [ value-too-large ] } - { INVALID_ARGS [ invalid-arguments ] } - { NOT_STORED [ item-not-stored ] } - { NOT_NUMERIC [ value-not-numeric ] } - { UNKNOWN_CMD [ unknown-command ] } - { MEMORY [ out-of-memory ] } + { NOT_FOUND [ throw-key-not-found ] } + { EXISTS [ throw-key-exists ] } + { TOO_LARGE [ throw-value-too-large ] } + { INVALID_ARGS [ throw-invalid-arguments ] } + { NOT_STORED [ throw-item-not-stored ] } + { NOT_NUMERIC [ throw-value-not-numeric ] } + { UNKNOWN_CMD [ throw-unknown-command ] } + { MEMORY [ throw-out-of-memory ] } [ drop ] } case ; diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index d635b4d83c..778dd8e7fb 100644 --- a/extra/memory/piles/piles.factor +++ b/extra/memory/piles/piles.factor @@ -21,7 +21,7 @@ M: pile dispose : pile-alloc ( pile size -- alien ) [ [ [ ] [ size>> ] [ offset>> ] tri ] dip + - < [ not-enough-pile-space ] [ drop ] if + < [ throw-not-enough-pile-space ] [ drop ] if ] [ drop [ offset>> ] [ underlying>> ] bi ] [ diff --git a/extra/metar/metar.factor b/extra/metar/metar.factor index 54c26dfab4..a874da893d 100644 --- a/extra/metar/metar.factor +++ b/extra/metar/metar.factor @@ -22,7 +22,7 @@ ERROR: bad-location str ; { 3 [ first3 [ string>number ] tri@ 60.0 / + 60.0 / + ] } { 2 [ first2 [ string>number ] bi@ 60.0 / + ] } { 1 [ first string>number ] } - [ drop bad-location ] + [ drop throw-bad-location ] } case ; : string>longitude ( str -- lon/f ) diff --git a/extra/money/money.factor b/extra/money/money.factor index a3ac4ebb13..431f250a2c 100644 --- a/extra/money/money.factor +++ b/extra/money/money.factor @@ -26,7 +26,7 @@ ERROR: not-an-integer x ; [ "-" ?head swap ] dip [ [ "0" ] when-empty ] bi@ [ - [ dup string>number [ nip ] [ not-an-integer ] if* ] bi@ + [ dup string>number [ nip ] [ throw-not-an-integer ] if* ] bi@ ] keep length 10^ / + swap [ neg ] when ; diff --git a/extra/mongodb/connection/connection.factor b/extra/mongodb/connection/connection.factor index b2801c11b9..3b2ce203bc 100644 --- a/extra/mongodb/connection/connection.factor +++ b/extra/mongodb/connection/connection.factor @@ -148,7 +148,10 @@ ERROR: mongod-connection-error address message ; clone [ verify-nodes ] [ ] [ ] tri master-node [ open-connection [ authenticate-connection ] keep - ] [ drop nip address>> "Could not open connection to mongod" mongod-connection-error ] recover ; + ] [ + drop nip address>> "Could not open connection to mongod" + throw-mongod-connection-error + ] recover ; : mdb-close ( mdb-connection -- ) [ [ dispose ] when* f ] change-handle drop ; diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index bfad87b739..a0ca3fd54a 100644 --- a/extra/mongodb/driver/driver.factor +++ b/extra/mongodb/driver/driver.factor @@ -267,7 +267,7 @@ M: mdb-collection validate. diff --git a/extra/morse/morse.factor b/extra/morse/morse.factor index 86c599137b..db86cdb32c 100755 --- a/extra/morse/morse.factor +++ b/extra/morse/morse.factor @@ -160,7 +160,7 @@ CONSTANT: beep-freq 880 { dash-char [ dash ] } { word-gap-char [ intra-char-gap ] } { unknown-char [ intra-char-gap ] } - [ no-morse-ch ] + [ throw-no-morse-ch ] } case ] interleave ; diff --git a/extra/msgpack/msgpack.factor b/extra/msgpack/msgpack.factor index 021a96c3bb..1519d43859 100644 --- a/extra/msgpack/msgpack.factor +++ b/extra/msgpack/msgpack.factor @@ -66,7 +66,7 @@ ERROR: unknown-format n ; { [ dup 0xc7 = ] [ drop read1 read-ext ] } { [ dup 0xc8 = ] [ drop 2 read be> read-ext ] } { [ dup 0xc9 = ] [ drop 4 read be> read-ext ] } - [ unknown-format ] + [ throw-unknown-format ] } cond ; ERROR: cannot-convert obj ; @@ -89,7 +89,7 @@ M: integer write-msgpack { [ dup 0xffff <= ] [ 0xcd write1 2 >be write ] } { [ dup 0xffffffff <= ] [ 0xce write1 4 >be write ] } { [ dup 0xffffffffffffffff <= ] [ 0xcf write1 8 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond ] [ { @@ -98,7 +98,7 @@ M: integer write-msgpack { [ dup -0x8000 >= ] [ 0xd1 write1 2 >be write ] } { [ dup -0x80000000 >= ] [ 0xd2 write1 4 >be write ] } { [ dup -0x8000000000000000 >= ] [ 0xd3 write1 8 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond ] if ; @@ -111,7 +111,7 @@ M: string write-msgpack { [ dup 0xff <= ] [ 0xd9 write1 write1 ] } { [ dup 0xffff <= ] [ 0xda write1 2 >be write ] } { [ dup 0xffffffff <= ] [ 0xdb write1 4 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond output-stream get utf8 encode-string ; M: byte-array write-msgpack @@ -119,7 +119,7 @@ M: byte-array write-msgpack { [ dup 0xff <= ] [ 0xc4 write1 write1 ] } { [ dup 0xffff <= ] [ 0xc5 write1 2 >be write ] } { [ dup 0xffffffff <= ] [ 0xc6 write1 4 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond write ; : write-array-header ( n -- ) @@ -127,7 +127,7 @@ M: byte-array write-msgpack { [ dup 0xf <= ] [ 0x90 bitor write1 ] } { [ dup 0xffff <= ] [ 0xdc write1 2 >be write ] } { [ dup 0xffffffff <= ] [ 0xdd write1 4 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond ; M: sequence write-msgpack @@ -138,7 +138,7 @@ M: sequence write-msgpack { [ dup 0xf <= ] [ 0x80 bitor write1 ] } { [ dup 0xffff <= ] [ 0xde write1 2 >be write ] } { [ dup 0xffffffff <= ] [ 0xdf write1 4 >be write ] } - [ cannot-convert ] + [ throw-cannot-convert ] } cond ; M: assoc write-msgpack diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index aa62a4391d..0ff11df213 100644 --- a/extra/noise/noise.factor +++ b/extra/noise/noise.factor @@ -53,7 +53,7 @@ ERROR: invalid-perlin-noise-table table ; : validate-table ( table -- table ) dup { [ byte-array? ] [ length 512 >= ] } 1&& - [ invalid-perlin-noise-table ] unless ; + [ throw-invalid-perlin-noise-table ] unless ; ! XXX doesn't work when v is nan or |v| >= 2^31 : floor-vector ( v -- v' ) diff --git a/extra/opencl/ffi/ffi-tests.factor b/extra/opencl/ffi/ffi-tests.factor index 4f4e5fb7e1..f9b7dde262 100644 --- a/extra/opencl/ffi/ffi-tests.factor +++ b/extra/opencl/ffi/ffi-tests.factor @@ -21,7 +21,7 @@ __kernel void square( ERROR: cl-error err ; : cl-success ( err -- ) - dup CL_SUCCESS = [ drop ] [ cl-error ] if ; + dup CL_SUCCESS = [ drop ] [ throw-cl-error ] if ; :: cl-string-array ( str -- alien ) str ascii encode 0 suffix :> str-buffer diff --git a/extra/opencl/opencl.factor b/extra/opencl/opencl.factor index 8325be9a9c..2a9819c642 100644 --- a/extra/opencl/opencl.factor +++ b/extra/opencl/opencl.factor @@ -13,10 +13,10 @@ SPECIALIZED-ARRAYS: void* char size_t ; ERROR: cl-error err ; : cl-success ( err -- ) - dup CL_SUCCESS = [ drop ] [ cl-error ] if ; inline + dup CL_SUCCESS = [ drop ] [ throw-cl-error ] if ; inline : cl-not-null ( err -- ) - dup f = [ cl-error ] [ drop ] if ; inline + dup f = [ throw-cl-error ] [ drop ] if ; inline : info-data-size ( handle name info-quot -- size_t ) [ 0 f 0 size_t ] dip [ call cl-success ] 2keep drop size_t deref ; inline @@ -354,7 +354,7 @@ M: cl-filter-linear filter-mode-constant drop CL_FILTER_LINEAR ; { { CL_BUILD_PROGRAM_FAILURE [ program-handle device id>> program-build-log program-handle - clReleaseProgram cl-success cl-error f ] } + clReleaseProgram cl-success throw-cl-error f ] } { CL_SUCCESS [ cl-program new-disposable program-handle >>handle ] } [ program-handle clReleaseProgram cl-success cl-success f ] } case ; diff --git a/extra/pair-methods/pair-methods.factor b/extra/pair-methods/pair-methods.factor index 13814015a8..a4e0b15b9b 100644 --- a/extra/pair-methods/pair-methods.factor +++ b/extra/pair-methods/pair-methods.factor @@ -25,7 +25,7 @@ ERROR: no-pair-method a b generic ; : pair-generic-definition ( word -- def ) [ sorted-pair-methods [ first2 pair-method-cond ] map ] - [ [ no-pair-method ] curry suffix ] bi 1quotation + [ [ throw-no-pair-method ] curry suffix ] bi 1quotation [ 2dup [ class-of ] compare +gt+ eq? ?swap ] [ cond ] surround ; : make-pair-generic ( word -- ) diff --git a/extra/pairs/pairs.factor b/extra/pairs/pairs.factor index 201b91e5e7..4835248cc6 100644 --- a/extra/pairs/pairs.factor +++ b/extra/pairs/pairs.factor @@ -31,7 +31,7 @@ M: pair set-at ERROR: cannot-delete-key pair ; M: pair delete-at - [ cannot-delete-key ] [ + [ throw-cannot-delete-key ] [ [ delete-at ] [ 2drop ] if-hash ] if-key ; inline diff --git a/extra/pcre/pcre.factor b/extra/pcre/pcre.factor index e17eeaa71e..cad0bd4875 100644 --- a/extra/pcre/pcre.factor +++ b/extra/pcre/pcre.factor @@ -31,7 +31,7 @@ ERROR: pcre-error value ; ] [ 2drop f ] if* ; : check-bad-option ( err value what -- value ) - rot 0 = [ drop ] [ bad-option ] if ; + rot 0 = [ drop ] [ throw-bad-option ] if ; : pcre-config ( what -- value ) [ @@ -81,7 +81,7 @@ CONSTANT: default-opts flags{ PCRE_UTF8 PCRE_UCP } default-opts { c-string int } [ f pcre_compile ] with-out-parameters ; : ( expr -- pcre ) - dup (pcre) 2array swap [ 2nip ] [ malformed-regexp ] if* ; + dup (pcre) 2array swap [ 2nip ] [ throw-malformed-regexp ] if* ; : ( pcre -- pcre-extra ) 0 { c-string } [ pcre_study ] with-out-parameters drop ; @@ -104,7 +104,7 @@ CONSTANT: empty-match-opts flags{ PCRE_NOTEMPTY_ATSTART PCRE_ANCHORED } [ ofs>> ] [ exec-opts>> ] } cleave exec over dup -1 < [ - PCRE_ERRORS number>enum pcre-error + PCRE_ERRORS number>enum throw-pcre-error ] [ -1 = [ 2drop dup exec-opts>> 0 = diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor index 50d0feebd1..9979a3be5e 100644 --- a/extra/poker/poker.factor +++ b/extra/poker/poker.factor @@ -198,7 +198,7 @@ ERROR: no-card card deck ; : draw-specific-card ( card deck -- card ) [ >ckf ] dip - 2dup index [ swap remove-nth! drop ] [ no-card ] if* ; + 2dup index [ swap remove-nth! drop ] [ throw-no-card ] if* ; : start-hands ( seq -- seq' deck ) [ '[ [ _ draw-specific-card ] map ] map ] keep ; @@ -248,7 +248,7 @@ ERROR: bad-suit-symbol ch ; { CHAR: D CHAR: D } { CHAR: H CHAR: H } { CHAR: C CHAR: C } - } ?at [ bad-suit-symbol ] unless ; + } ?at [ throw-bad-suit-symbol ] unless ; : card> ( string -- card ) 1 over [ symbol>suit ] change-nth >ckf ; diff --git a/extra/progress-bars/progress-bars.factor b/extra/progress-bars/progress-bars.factor index b397a0b287..4d856b82c0 100644 --- a/extra/progress-bars/progress-bars.factor +++ b/extra/progress-bars/progress-bars.factor @@ -7,12 +7,12 @@ IN: progress-bars ERROR: invalid-percent x ; : check-percent ( x -- x ) - dup 0 1 between? [ invalid-percent ] unless ; + dup 0 1 between? [ throw-invalid-percent ] unless ; ERROR: invalid-length x ; : check-length ( x -- x ) - dup { [ 0 > ] [ integer? ] } 1&& [ invalid-length ] unless ; + dup { [ 0 > ] [ integer? ] } 1&& [ throw-invalid-length ] unless ; : (make-progress-bar) ( percent len completed-ch pending-ch -- string ) [ [ * >integer ] keep over - ] 2dip diff --git a/extra/redis/response-parser/response-parser.factor b/extra/redis/response-parser/response-parser.factor index 5b4f0b3283..0121bf8cf1 100644 --- a/extra/redis/response-parser/response-parser.factor +++ b/extra/redis/response-parser/response-parser.factor @@ -24,7 +24,7 @@ ERROR: redis-error message ; ; : handle-error ( string -- * ) - redis-error ; + throw-redis-error ; PRIVATE> diff --git a/extra/resolv-conf/resolv-conf.factor b/extra/resolv-conf/resolv-conf.factor index b6eefd2147..8fe2473a4a 100644 --- a/extra/resolv-conf/resolv-conf.factor +++ b/extra/resolv-conf/resolv-conf.factor @@ -68,7 +68,7 @@ ERROR: unsupported-resolv.conf-option string ; { [ "rotate" ?head ] [ drop t >>rotate? ] } { [ "no-check-names" ?head ] [ drop t >>no-check-names? ] } { [ "inet6" ?head ] [ drop t >>inet6? ] } - [ unsupported-resolv.conf-option ] + [ throw-unsupported-resolv.conf-option ] } cond drop ; ERROR: unsupported-resolv.conf-line string ; @@ -81,7 +81,7 @@ ERROR: unsupported-resolv.conf-line string ; { [ "search" ?head ] [ parse-search ] } { [ "sortlist" ?head ] [ parse-sortlist ] } { [ "options" ?head ] [ parse-option ] } - [ unsupported-resolv.conf-line ] + [ throw-unsupported-resolv.conf-line ] } cond ; PRIVATE> diff --git a/extra/roles/roles.factor b/extra/roles/roles.factor index e32503e76b..c6c74bbd46 100644 --- a/extra/roles/roles.factor +++ b/extra/roles/roles.factor @@ -36,7 +36,7 @@ PREDICATE: role < mixin-class : check-for-slot-overlap ( class roles-and-superclass slots -- ) [ [ role-or-tuple-slot-names ] map concat ] [ slot-names ] bi* append - duplicates dup empty? [ 2drop ] [ role-slot-overlap ] if ; + duplicates dup empty? [ 2drop ] [ throw-role-slot-overlap ] if ; : roles>slots ( roles-and-superclass slots -- superclass slots' ) [ @@ -44,7 +44,7 @@ PREDICATE: role < mixin-class dup length { { 0 [ drop tuple ] } { 1 [ first ] } - [ drop multiple-inheritance-attempted ] + [ drop throw-multiple-inheritance-attempted ] } case swap [ role-slots ] map concat ] dip append ; diff --git a/extra/smalltalk/classes/classes.factor b/extra/smalltalk/classes/classes.factor index 0790cde7d9..142904e008 100644 --- a/extra/smalltalk/classes/classes.factor +++ b/extra/smalltalk/classes/classes.factor @@ -13,7 +13,7 @@ classes [ H{ } clone ] initialize ERROR: no-class name ; : lookup-class ( class -- class ) - classes get ?at [ no-class ] unless ; + classes get ?at [ throw-no-class ] unless ; : define-class ( class superclass ivars -- class-word ) [ create-class ] [ lookup-class ] [ ] tri* diff --git a/extra/smalltalk/compiler/lexenv/lexenv.factor b/extra/smalltalk/compiler/lexenv/lexenv.factor index 3a7d29e6da..42ffccb400 100644 --- a/extra/smalltalk/compiler/lexenv/lexenv.factor +++ b/extra/smalltalk/compiler/lexenv/lexenv.factor @@ -47,7 +47,7 @@ M: bad-identifier summary drop "Unknown identifier" ; [ local-reader ] [ ivar-reader ] [ drop class-name ] - [ drop bad-identifier ] + [ drop throw-bad-identifier ] } 2|| ; : local-writer ( name lexenv -- local ) @@ -63,5 +63,5 @@ M: bad-identifier summary drop "Unknown identifier" ; { [ local-writer ] [ ivar-writer ] - [ drop bad-identifier ] + [ drop throw-bad-identifier ] } 2|| ; diff --git a/extra/smalltalk/parser/parser.factor b/extra/smalltalk/parser/parser.factor index 6de20afc6d..ae58d6c0b9 100644 --- a/extra/smalltalk/parser/parser.factor +++ b/extra/smalltalk/parser/parser.factor @@ -11,7 +11,7 @@ IN: smalltalk.parser ERROR: bad-number str ; : check-number ( str -- n ) - >string dup string>number [ ] [ bad-number ] ?if ; + >string dup string>number [ ] [ throw-bad-number ] ?if ; EBNF: parse-smalltalk diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index 1417c07eed..c8f2c3212a 100644 --- a/extra/tar/tar.factor +++ b/extra/tar/tar.factor @@ -74,7 +74,7 @@ TYPED: checksum-header ( seq: byte-array -- n ) [ binary [ read-tar-header ] with-byte-reader dup checksum>> - ] dip = [ checksum-error ] unless + ] dip = [ throw-checksum-error ] unless ] if ; ERROR: unknown-typeflag ch ; diff --git a/extra/taxes/usa/fica/fica.factor b/extra/taxes/usa/fica/fica.factor index 4541a15eca..181a891ea2 100644 --- a/extra/taxes/usa/fica/fica.factor +++ b/extra/taxes/usa/fica/fica.factor @@ -12,7 +12,7 @@ ERROR: fica-base-unknown ; { 2009 106800 } { 2008 102000 } { 2007 97500 } - } at [ fica-base-unknown ] unless* ; + } at [ throw-fica-base-unknown ] unless* ; : fica-tax ( salary w4 -- x ) year>> fica-base-rate min fica-tax-rate * ; diff --git a/extra/terminfo/terminfo.factor b/extra/terminfo/terminfo.factor index 3372a07e82..4093e41e93 100644 --- a/extra/terminfo/terminfo.factor +++ b/extra/terminfo/terminfo.factor @@ -18,7 +18,7 @@ CONSTANT: MAGIC 0o432 ERROR: bad-magic ; : check-magic ( n -- ) - MAGIC = [ bad-magic ] unless ; + MAGIC = [ throw-bad-magic ] unless ; TUPLE: terminfo-header names-bytes boolean-bytes #numbers #strings string-bytes ; diff --git a/extra/tzinfo/tzinfo.factor b/extra/tzinfo/tzinfo.factor index 998353eab4..02a81ee96c 100644 --- a/extra/tzinfo/tzinfo.factor +++ b/extra/tzinfo/tzinfo.factor @@ -27,7 +27,7 @@ PACKED-STRUCT: ttinfo ERROR: bad-magic ; : check-magic ( -- ) - 4 read "TZif" sequence= [ bad-magic ] unless ; + 4 read "TZif" sequence= [ throw-bad-magic ] unless ; TUPLE: tzfile header transition-times local-times types abbrevs leaps is-std is-gmt ; diff --git a/extra/units/units.factor b/extra/units/units.factor index 6bc2242074..51ada98c93 100644 --- a/extra/units/units.factor +++ b/extra/units/units.factor @@ -34,7 +34,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ; : check-dimensions ( d d -- ) [ dimensions 2array ] same? - [ dimensions-not-equal ] unless ; + [ throw-dimensions-not-equal ] unless ; : 2values ( dim dim -- val val ) [ value>> ] bi@ ; diff --git a/extra/usa-cities/usa-cities.factor b/extra/usa-cities/usa-cities.factor index 111ea99159..d1020037d9 100644 --- a/extra/usa-cities/usa-cities.factor +++ b/extra/usa-cities/usa-cities.factor @@ -22,7 +22,7 @@ M: no-such-state summary drop "No such state" ; MEMO: string>state ( string -- state ) dup states [ name>> = ] with find nip - [ ] [ no-such-state ] ?if ; + [ ] [ throw-no-such-state ] ?if ; TUPLE: city first-zip name state latitude longitude gmt-offset dst-offset ; diff --git a/extra/uu/uu.factor b/extra/uu/uu.factor index c1d23e0d9a..f30b3da56b 100644 --- a/extra/uu/uu.factor +++ b/extra/uu/uu.factor @@ -11,7 +11,7 @@ IN: uu ERROR: bad-length seq ; : check-length ( seq -- seq ) - dup length 45 > [ bad-length ] when ; inline + dup length 45 > [ throw-bad-length ] when ; inline :: binary>ascii ( seq -- seq' ) 0 :> char! @@ -41,7 +41,7 @@ ERROR: illegal-character ch ; : check-illegal-character ( ch -- ch ) dup { [ CHAR: \s < ] [ CHAR: \s 64 + > ] } 1|| - [ illegal-character ] when ; + [ throw-illegal-character ] when ; :: ascii>binary ( seq -- seq' ) 0 :> char! diff --git a/extra/vocabs/git/git.factor b/extra/vocabs/git/git.factor index 8e1c30fae3..1792fdc3cb 100644 --- a/extra/vocabs/git/git.factor +++ b/extra/vocabs/git/git.factor @@ -23,6 +23,6 @@ ERROR: git-revision-not-found path ; : use-vocab-rev ( vocab-name rev -- ) [ create-vocab vocab-source-path dup ] dip git-object-id [ [ input-stream get swap parse-stream call( -- ) ] with-git-object-stream ] - [ git-revision-not-found ] if* ; + [ throw-git-revision-not-found ] if* ; SYNTAX: USE-REV: scan-token scan-token use-vocab-rev ; diff --git a/extra/yaml/yaml.factor b/extra/yaml/yaml.factor index 058ead1e53..09d2908c77 100644 --- a/extra/yaml/yaml.factor +++ b/extra/yaml/yaml.factor @@ -22,7 +22,7 @@ ERROR: yaml-no-document ; > ] [ context>> ] [ context_mark>> ] - } cleave [ clone ] 7 napply libyaml-parser-error ; + } cleave [ clone ] 7 napply throw-libyaml-parser-error ; : (libyaml-emitter-error) ( emitter -- ) - [ error>> ] [ problem>> ] bi [ clone ] bi@ libyaml-emitter-error ; + [ error>> ] [ problem>> ] bi [ clone ] bi@ throw-libyaml-emitter-error ; : yaml-parser-assert-ok ( ? parser -- ) swap [ drop ] [ (libyaml-parser-error) ] if ; @@ -60,7 +60,7 @@ SYMBOL: anchors : assert-anchor-exists ( anchor -- ) anchors get 2dup at* nip - [ 2drop ] [ yaml-undefined-anchor ] if ; + [ 2drop ] [ throw-yaml-undefined-anchor ] if ; : deref-anchor ( event -- obj ) data>> alias>> anchor>> @@ -182,7 +182,7 @@ DEFER: parse-mapping : expect-event ( parser event type -- ) [ [ next-event type>> ] dip 2dup = - [ 2drop ] [ 1array yaml-unexpected-event ] if + [ 2drop ] [ 1array throw-yaml-unexpected-event ] if ] with-destructors ; ! Same as 'with', but for combinators that @@ -257,7 +257,7 @@ M: assoc apply-merge-keys parser event next-event type>> { { YAML_DOCUMENT_START_EVENT [ t ] } { YAML_STREAM_END_EVENT [ f ] } - [ { YAML_DOCUMENT_START_EVENT YAML_STREAM_END_EVENT } yaml-unexpected-event ] + [ { YAML_DOCUMENT_START_EVENT YAML_STREAM_END_EVENT } throw-yaml-unexpected-event ] } case ] with-destructors [ parser event parse-yaml-doc t @@ -283,7 +283,7 @@ PRIVATE> [ init-parser [ YAML_STREAM_START_EVENT expect-event ] - [ ?parse-yaml-doc [ yaml-no-document ] unless ] 2bi + [ ?parse-yaml-doc [ throw-yaml-no-document ] unless ] 2bi ] with-destructors ; : yaml-docs> ( str -- arr ) diff --git a/extra/zoneinfo/zoneinfo.factor b/extra/zoneinfo/zoneinfo.factor index 89710e7822..d6fbc2a7af 100644 --- a/extra/zoneinfo/zoneinfo.factor +++ b/extra/zoneinfo/zoneinfo.factor @@ -154,7 +154,7 @@ ERROR: zone-not-found name ; : find-zone ( string -- rules ) raw-zone-map - [ last ] assoc-map ?at [ zone-not-found ] unless ; + [ last ] assoc-map ?at [ throw-zone-not-found ] unless ; : find-zone-rules ( string -- zone rules ) find-zone dup rules/save>> find-rules ; -- 2.34.1