From ceb75057dab980473c6e72170d6e69df513169c7 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 13 Aug 2015 16:13:05 -0700 Subject: [PATCH] change ERROR: words from throw-foo back to foo. --- basis/alien/c-types/c-types.factor | 4 +-- basis/alien/data/data.factor | 2 +- basis/alien/endian/endian.factor | 2 +- basis/alien/libraries/libraries.factor | 4 +-- basis/alien/parser/parser.factor | 2 +- basis/base64/base64.factor | 4 +-- basis/biassocs/biassocs.factor | 2 +- basis/bit-arrays/bit-arrays.factor | 2 +- basis/bit-sets/bit-sets.factor | 2 +- basis/bitstreams/bitstreams.factor | 6 ++-- basis/bootstrap/help/help.factor | 2 +- basis/bootstrap/image/image.factor | 4 +-- basis/boxes/boxes.factor | 2 +- basis/byte-arrays/hex/hex.factor | 2 +- basis/cairo/cairo.factor | 2 +- basis/calendar/calendar.factor | 4 +-- basis/calendar/format/format.factor | 2 +- basis/checksums/openssl/openssl.factor | 2 +- basis/classes/struct/struct.factor | 6 ++-- basis/cocoa/messages/messages.factor | 4 +-- basis/cocoa/plists/plists.factor | 2 +- basis/colors/constants/constants.factor | 2 +- basis/combinators/random/random.factor | 2 +- .../short-circuit/smart/smart.factor | 2 +- .../cfg/alias-analysis/alias-analysis.factor | 2 +- basis/compiler/cfg/checker/checker.factor | 2 +- .../compiler/cfg/intrinsics/intrinsics.factor | 2 +- .../intrinsics/simd/backend/backend.factor | 2 +- .../allocation/spilling/spilling.factor | 2 +- .../allocation/splitting/splitting.factor | 6 ++-- .../linear-scan/allocation/state/state.factor | 2 +- .../linear-scan/assignment/assignment.factor | 2 +- .../live-intervals/live-intervals.factor | 2 +- .../linear-scan/numbering/numbering.factor | 2 +- basis/compiler/cfg/registers/registers.factor | 2 +- .../conversion/conversion.factor | 2 +- .../destruction/coalescing/coalescing.factor | 2 +- .../live-ranges/live-ranges.factor | 2 +- .../cfg/stacks/finalize/finalize.factor | 2 +- .../cfg/stacks/padding/padding.factor | 4 +-- basis/compiler/tests/intrinsics.factor | 2 +- basis/compiler/tree/checker/checker.factor | 6 ++-- basis/compiler/tree/def-use/def-use.factor | 4 +-- .../call-effect/call-effect-tests.factor | 2 +- .../call-effect/call-effect.factor | 8 ++--- .../tree/propagation/simple/simple.factor | 2 +- .../propagation/transforms/transforms.factor | 2 +- basis/compression/inflate/inflate.factor | 8 ++--- basis/compression/lzw/lzw.factor | 2 +- basis/compression/snappy/snappy.factor | 2 +- basis/compression/zlib/zlib.factor | 4 +-- .../concurrency/conditions/conditions.factor | 2 +- .../count-downs/count-downs.factor | 4 +-- basis/concurrency/messaging/messaging.factor | 2 +- basis/concurrency/promises/promises.factor | 2 +- .../concurrency/semaphores/semaphores.factor | 2 +- .../launch-services/launch-services.factor | 2 +- basis/core-foundation/numbers/numbers.factor | 2 +- basis/core-text/core-text.factor | 2 +- basis/cpu/x86/assembler/assembler.factor | 10 +++--- .../x86/assembler/operands/operands.factor | 2 +- basis/db/postgresql/lib/lib.factor | 2 +- basis/db/postgresql/postgresql.factor | 2 +- basis/db/queries/queries.factor | 2 +- basis/db/sqlite/lib/lib.factor | 4 +-- basis/db/sqlite/sqlite.factor | 2 +- basis/db/tuples/tuples.factor | 4 +-- basis/db/types/types.factor | 8 ++--- basis/delegate/delegate.factor | 4 +-- basis/deques/deques.factor | 4 +-- basis/editors/editors.factor | 4 +-- basis/formatting/formatting.factor | 2 +- basis/fry/fry.factor | 2 +- basis/ftp/client/client.factor | 2 +- basis/ftp/server/server.factor | 2 +- basis/furnace/asides/asides.factor | 2 +- basis/furnace/utilities/utilities.factor | 4 +-- basis/game/input/input.factor | 2 +- basis/generalizations/generalizations.factor | 2 +- .../gobject-introspection.factor | 2 +- .../gobject-introspection/types/types.factor | 6 ++-- basis/grouping/grouping.factor | 2 +- basis/heaps/heaps.factor | 4 +-- basis/help/lint/checks/checks.factor | 28 +++++++-------- basis/help/markup/markup.factor | 4 +-- basis/help/syntax/syntax.factor | 2 +- basis/help/topics/topics.factor | 2 +- basis/hints/hints.factor | 2 +- .../templates/chloe/compiler/compiler.factor | 2 +- basis/html/templates/templates.factor | 4 +-- basis/http/client/client.factor | 2 +- basis/http/server/requests/requests.factor | 12 +++---- basis/images/loader/gdiplus/gdiplus.factor | 2 +- basis/images/loader/loader.factor | 2 +- basis/interval-maps/interval-maps.factor | 2 +- basis/interval-sets/interval-sets.factor | 2 +- basis/inverse/inverse.factor | 10 +++--- basis/io/backend/unix/unix.factor | 4 +-- basis/io/directories/search/search.factor | 4 +-- basis/io/encodings/8-bit/8-bit.factor | 2 +- basis/io/encodings/euc/euc.factor | 2 +- basis/io/encodings/gb18030/gb18030.factor | 2 +- basis/io/encodings/iso2022/iso2022.factor | 2 +- basis/io/encodings/shift-jis/shift-jis.factor | 2 +- basis/io/encodings/strict/strict.factor | 2 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/links/links.factor | 2 +- basis/io/files/windows/windows.factor | 2 +- basis/io/launcher/launcher.factor | 8 ++--- basis/io/launcher/windows/windows.factor | 2 +- basis/io/mmap/mmap.factor | 2 +- basis/io/ports/ports.factor | 2 +- basis/io/servers/servers.factor | 4 +-- .../io/sockets/secure/openssl/openssl.factor | 18 +++++----- basis/io/sockets/sockets.factor | 24 ++++++------- basis/io/streams/duplex/duplex.factor | 2 +- basis/io/streams/limited/limited.factor | 4 +-- basis/io/streams/throwing/throwing.factor | 8 ++--- basis/json/reader/reader.factor | 6 ++-- basis/libc/libc.factor | 6 ++-- basis/locals/locals.factor | 2 +- basis/locals/parser/parser.factor | 4 +-- .../rewrite/point-free/point-free.factor | 2 +- basis/locals/rewrite/sugar/sugar.factor | 4 +-- basis/logging/logging.factor | 4 +-- basis/macros/macros.factor | 2 +- basis/match/match.factor | 2 +- basis/math/bitwise/bitwise.factor | 2 +- basis/math/complex/complex.factor | 2 +- basis/math/functions/functions.factor | 2 +- basis/math/matrices/matrices.factor | 2 +- .../partial-dispatch/partial-dispatch.factor | 2 +- basis/math/polynomials/polynomials.factor | 2 +- .../primes/lucas-lehmer/lucas-lehmer.factor | 2 +- basis/math/primes/primes.factor | 4 +-- .../conversion/conversion-tests.factor | 2 +- .../math/vectors/conversion/conversion.factor | 8 ++--- basis/math/vectors/simd/simd.factor | 4 +-- basis/mime/multipart/multipart.factor | 4 +-- basis/mirrors/mirrors.factor | 4 +-- basis/multiline/multiline.factor | 4 +-- basis/nibble-arrays/nibble-arrays.factor | 2 +- .../annotations/annotations-docs.factor | 6 ++-- basis/opengl/gl/extensions/extensions.factor | 2 +- basis/opengl/textures/textures.factor | 20 +++++------ basis/pack/pack.factor | 2 +- basis/peg/ebnf/ebnf.factor | 6 ++-- basis/peg/peg.factor | 2 +- basis/persistent/vectors/vectors.factor | 2 +- basis/random/random.factor | 6 ++-- basis/random/windows/windows.factor | 2 +- basis/regexp/parser/parser.factor | 12 +++---- basis/roman/roman.factor | 2 +- basis/sequences/unrolled/unrolled.factor | 4 +-- basis/smtp/smtp.factor | 26 +++++++------- .../specialized-arrays.factor | 10 +++--- .../stack-checker/stack-checker-tests.factor | 4 +-- basis/tools/annotations/annotations.factor | 2 +- .../annotations/assertions/assertions.factor | 4 +-- basis/tools/deploy/backend/backend.factor | 2 +- basis/tools/deploy/deploy.factor | 4 +-- .../shaker/strip-specialized-arrays.factor | 2 +- basis/tools/deploy/test/test.factor | 2 +- basis/tools/deploy/windows/ico/ico.factor | 4 +-- basis/tools/files/files.factor | 2 +- basis/tools/scaffold/scaffold.factor | 4 +-- basis/tr/tr.factor | 2 +- basis/tuple-arrays/tuple-arrays.factor | 4 +-- basis/typed/namespaces/namespaces.factor | 4 +-- basis/typed/typed.factor | 6 ++-- basis/ui/gadgets/labels/labels.factor | 2 +- basis/ui/gadgets/worlds/worlds.factor | 2 +- basis/ui/pixel-formats/pixel-formats.factor | 2 +- basis/unix/groups/groups.factor | 2 +- basis/unix/linux/proc/proc.factor | 2 +- basis/unix/unix.factor | 4 +-- basis/unix/users/users.factor | 4 +-- basis/unrolled-lists/unrolled-lists.factor | 4 +-- basis/urls/urls.factor | 2 +- basis/vlists/vlists.factor | 2 +- basis/vocabs/hierarchy/hierarchy.factor | 2 +- basis/vocabs/metadata/metadata.factor | 10 +++--- basis/windows/com/com.factor | 2 +- basis/windows/com/syntax/syntax.factor | 2 +- basis/windows/gdiplus/gdiplus.factor | 2 +- basis/windows/iphlpapi/iphlpapi.factor | 2 +- basis/windows/registry/registry.factor | 4 +-- basis/windows/winmm/winmm.factor | 2 +- basis/windows/winsock/winsock.factor | 10 +++--- basis/xml-rpc/xml-rpc.factor | 4 +-- basis/xml/syntax/syntax.factor | 2 +- core/alien/alien.factor | 8 ++--- core/alien/strings/strings.factor | 2 +- core/classes/algebra/algebra.factor | 8 ++--- core/classes/builtin/builtin.factor | 2 +- core/classes/classes.factor | 2 +- core/classes/error/error-tests.factor | 6 ++-- core/classes/error/error.factor | 7 ---- core/classes/mixin/mixin.factor | 2 +- core/classes/tuple/parser/parser.factor | 14 ++++---- core/classes/tuple/tuple.factor | 6 ++-- core/classes/union/union.factor | 2 +- core/combinators/combinators.factor | 2 +- core/continuations/continuations.factor | 2 +- core/definitions/definitions.factor | 2 +- core/destructors/destructors.factor | 2 +- core/effects/effects.factor | 2 +- core/effects/parser/parser.factor | 8 ++--- core/generic/generic.factor | 2 +- core/generic/math/math.factor | 2 +- core/generic/parser/parser.factor | 2 +- core/generic/single/single.factor | 8 ++--- core/hashtables/hashtables.factor | 2 +- core/io/encodings/ascii/ascii.factor | 4 +-- core/io/encodings/utf16/utf16.factor | 2 +- core/io/pathnames/pathnames.factor | 4 +-- core/kernel/kernel.factor | 2 +- core/lexer/lexer.factor | 2 +- core/math/math.factor | 2 +- core/math/parser/parser.factor | 4 +-- core/math/ratios/ratios.factor | 4 +-- core/parser/parser.factor | 6 ++-- core/sequences/sequences.factor | 12 +++---- core/slots/slots.factor | 4 +-- core/source-files/source-files.factor | 2 +- core/strings/parser/parser.factor | 4 +-- core/syntax/syntax-docs.factor | 2 +- core/syntax/syntax.factor | 4 +-- core/vocabs/loader/loader-docs.factor | 2 +- core/vocabs/loader/loader.factor | 4 +-- core/vocabs/parser/parser.factor | 8 ++--- core/vocabs/vocabs.factor | 4 +-- core/words/words.factor | 6 ++-- .../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 | 6 ++-- 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 | 2 +- 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 | 4 +-- 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/google/translate/translate.factor | 4 +-- extra/gopher/gopher.factor | 2 +- extra/gpu/render/render.factor | 4 +-- extra/gpu/shaders/shaders.factor | 10 +++--- 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 | 2 +- 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/zeromq/zeromq.factor | 8 ++--- extra/zoneinfo/zoneinfo.factor | 2 +- 330 files changed, 653 insertions(+), 660 deletions(-) diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index 710c918604..4e0e4c111f 100644 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -55,12 +55,12 @@ UNION: c-type-name c-type-word pointer ; : resolve-typedef ( name -- c-type ) - dup void? [ throw-no-c-type ] when + dup void? [ no-c-type ] when dup c-type-name? [ lookup-c-type ] when ; M: word lookup-c-type dup "c-type" word-prop resolve-typedef - [ ] [ throw-no-c-type ] ?if ; + [ ] [ no-c-type ] ?if ; GENERIC: c-type-class ( name -- class ) diff --git a/basis/alien/data/data.factor b/basis/alien/data/data.factor index ba510f7ef3..789094fb8b 100644 --- a/basis/alien/data/data.factor +++ b/basis/alien/data/data.factor @@ -79,7 +79,7 @@ M: bad-byte-array-length summary : cast-array ( byte-array c-type -- array ) [ binary-object ] dip [ heap-size /mod 0 = ] keep swap - [ ] [ throw-bad-byte-array-length ] if ; inline + [ ] [ bad-byte-array-length ] if ; inline : malloc-array ( n c-type -- array ) [ heap-size calloc ] [ ] 2bi ; inline diff --git a/basis/alien/endian/endian.factor b/basis/alien/endian/endian.factor index 1847f6294b..a7593c05b7 100644 --- a/basis/alien/endian/endian.factor +++ b/basis/alien/endian/endian.factor @@ -15,7 +15,7 @@ ERROR: invalid-signed-conversion n ; { 2 [ [ c:short c:short deref ] ] } { 4 [ [ int int deref ] ] } { 8 [ [ longlong longlong deref ] ] } - [ throw-invalid-signed-conversion ] + [ invalid-signed-conversion ] } case ; inline MACRO: byte-reverse ( n signed? -- quot ) diff --git a/basis/alien/libraries/libraries.factor b/basis/alien/libraries/libraries.factor index 5e6d807db4..0232821c2b 100755 --- a/basis/alien/libraries/libraries.factor +++ b/basis/alien/libraries/libraries.factor @@ -80,7 +80,7 @@ M: library dispose dll>> [ dispose ] when* ; : address-of ( name library -- value ) 2dup load-library dlsym-raw - [ 2nip ] [ throw-no-such-symbol ] if* ; + [ 2nip ] [ no-such-symbol ] if* ; SYMBOL: deploy-libraries @@ -89,7 +89,7 @@ deploy-libraries [ V{ } clone ] initialize : deploy-library ( name -- ) dup libraries get key? [ deploy-libraries get 2dup member? [ 2drop ] [ push ] if ] - [ "deploy-library failure" throw-no-such-library ] if ; + [ "deploy-library failure" no-such-library ] if ; HOOK: >deployed-library-path os ( path -- path' ) diff --git a/basis/alien/parser/parser.factor b/basis/alien/parser/parser.factor index 507273eda2..843f0410aa 100755 --- a/basis/alien/parser/parser.factor +++ b/basis/alien/parser/parser.factor @@ -15,7 +15,7 @@ ERROR: bad-array-type ; : parse-array-type ( name -- c-type ) "[" split unclip - [ [ "]" ?tail [ throw-bad-array-type ] unless parse-datum ] map ] + [ [ "]" ?tail [ bad-array-type ] unless parse-datum ] map ] [ (parse-c-type) ] bi* prefix ; diff --git a/basis/base64/base64.factor b/basis/base64/base64.factor index db1ffc75bd..500784ef7f 100644 --- a/basis/base64/base64.factor +++ b/basis/base64/base64.factor @@ -24,7 +24,7 @@ CONSTANT: alphabet : base64>ch ( ch -- ch ) $[ alphabet alphabet-inverse 0 CHAR: = pick set-nth ] nth - [ throw-malformed-base64 ] unless* ; inline + [ malformed-base64 ] unless* ; inline : (write-lines) ( column byte-array -- column' ) output-stream get dup '[ @@ -84,7 +84,7 @@ PRIVATE> 4 "\n\r" pick read-ignoring dup length { { 0 [ 2drop ] } { 4 [ decode4 (decode-base64) ] } - [ throw-malformed-base64 ] + [ malformed-base64 ] } case ; PRIVATE> diff --git a/basis/biassocs/biassocs.factor b/basis/biassocs/biassocs.factor index 423b1a2809..590449d77c 100644 --- a/basis/biassocs/biassocs.factor +++ b/basis/biassocs/biassocs.factor @@ -29,7 +29,7 @@ M: no-biassoc-deletion summary drop "biassocs do not support deletion" ; M: biassoc delete-at - throw-no-biassoc-deletion ; + no-biassoc-deletion ; M: biassoc >alist from>> >alist ; diff --git a/basis/bit-arrays/bit-arrays.factor b/basis/bit-arrays/bit-arrays.factor index 4068c5e2cc..55fec5bba3 100644 --- a/basis/bit-arrays/bit-arrays.factor +++ b/basis/bit-arrays/bit-arrays.factor @@ -47,7 +47,7 @@ PRIVATE> ERROR: bad-array-length n ; : ( n -- bit-array ) - dup 0 < [ throw-bad-array-length ] when + dup 0 < [ bad-array-length ] when dup bits>bytes bit-array boa ; inline diff --git a/basis/bit-sets/bit-sets.factor b/basis/bit-sets/bit-sets.factor index a4c24f0bdc..2b4fb129ee 100644 --- a/basis/bit-sets/bit-sets.factor +++ b/basis/bit-sets/bit-sets.factor @@ -32,7 +32,7 @@ M: bit-set delete ERROR: check-bit-set-failed ; : check-bit-set ( bit-set -- bit-set ) - dup bit-set? [ throw-check-bit-set-failed ] unless ; inline + dup bit-set? [ check-bit-set-failed ] unless ; inline : bit-set-map ( seq1 seq2 quot -- seq ) [ drop [ length ] bi@ [ assert= ] keep ] diff --git a/basis/bitstreams/bitstreams.factor b/basis/bitstreams/bitstreams.factor index 9ece2a2cc5..f7cb370861 100644 --- a/basis/bitstreams/bitstreams.factor +++ b/basis/bitstreams/bitstreams.factor @@ -20,7 +20,7 @@ ERROR: invalid-widthed bits #bits ; dup 0 < [ neg ] when log2 <= ] if-zero ] - } 2|| [ throw-invalid-widthed ] when ; + } 2|| [ invalid-widthed ] when ; : ( bits #bits -- widthed ) check-widthed @@ -89,7 +89,7 @@ ERROR: not-enough-widthed-bits widthed n ; : check-widthed-bits ( widthed n -- widthed n ) 2dup { [ nip 0 < ] [ [ #bits>> ] dip < ] } 2|| - [ throw-not-enough-widthed-bits ] when ; + [ not-enough-widthed-bits ] when ; : widthed-bits ( widthed n -- bits ) check-widthed-bits @@ -161,7 +161,7 @@ ERROR: not-enough-bits n bit-reader ; ] if ; :: (peek) ( n bs endian> subseq-endian -- bits ) - n bs enough-bits? [ n bs throw-not-enough-bits ] unless + n bs enough-bits? [ n bs not-enough-bits ] unless bs [ byte-pos>> ] [ bit-pos>> n + ] bi #bits>#bytes dupd + bs bytes>> subseq endian> execute( seq -- x ) n bs subseq-endian execute( bignum n bs -- bits ) ; diff --git a/basis/bootstrap/help/help.factor b/basis/bootstrap/help/help.factor index 4d10a0beb0..85e94d5a1e 100644 --- a/basis/bootstrap/help/help.factor +++ b/basis/bootstrap/help/help.factor @@ -13,7 +13,7 @@ IN: bootstrap.help t load-help? set-global - [ dup lookup-vocab [ drop ] [ throw-no-vocab ] if ] require-hook [ + [ dup lookup-vocab [ drop ] [ no-vocab ] if ] require-hook [ dictionary get values [ docs-loaded?>> ] reject [ load-docs ] each diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index ddf5471fe2..dda459e595 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -365,7 +365,7 @@ ERROR: not-in-image vocabulary word ; : fixup-word ( word -- offset ) transfer-word dup lookup-object - [ ] [ [ vocabulary>> ] [ name>> ] bi throw-not-in-image ] ?if ; + [ ] [ [ vocabulary>> ] [ name>> ] bi not-in-image ] ?if ; : fixup-words ( -- ) bootstrapping-image get [ dup word? [ fixup-word ] when ] map! drop ; @@ -437,7 +437,7 @@ M: byte-array ' ERROR: tuple-removed class ; : require-tuple-layout ( word -- layout ) - dup tuple-layout [ ] [ throw-tuple-removed ] ?if ; + dup tuple-layout [ ] [ tuple-removed ] ?if ; : (emit-tuple) ( tuple -- pointer ) [ tuple-slots ] diff --git a/basis/boxes/boxes.factor b/basis/boxes/boxes.factor index 585389a571..25f2b963b4 100644 --- a/basis/boxes/boxes.factor +++ b/basis/boxes/boxes.factor @@ -11,7 +11,7 @@ ERROR: box-full box ; : >box ( value box -- ) dup occupied>> - [ throw-box-full ] [ t >>occupied value<< ] if ; inline + [ box-full ] [ t >>occupied value<< ] if ; inline ERROR: box-empty box ; diff --git a/basis/byte-arrays/hex/hex.factor b/basis/byte-arrays/hex/hex.factor index a59c1762ca..41444b54e6 100644 --- a/basis/byte-arrays/hex/hex.factor +++ b/basis/byte-arrays/hex/hex.factor @@ -9,6 +9,6 @@ ERROR: odd-length-hex-string string ; SYNTAX: HEX{ "}" parse-tokens concat [ blank? ] reject - dup length even? [ throw-odd-length-hex-string ] unless + dup length even? [ odd-length-hex-string ] unless 2 [ hex> ] B{ } map-as suffix! ; diff --git a/basis/cairo/cairo.factor b/basis/cairo/cairo.factor index 9ed9d3bdce..d3edd9022a 100644 --- a/basis/cairo/cairo.factor +++ b/basis/cairo/cairo.factor @@ -10,7 +10,7 @@ ERROR: cairo-error n message ; : (check-cairo) ( cairo_status_t -- ) dup CAIRO_STATUS_SUCCESS = - [ drop ] [ [ ] [ cairo_status_to_string ] bi throw-cairo-error ] if ; + [ drop ] [ [ ] [ cairo_status_to_string ] bi cairo-error ] if ; : check-cairo ( cairo -- ) cairo_status (check-cairo) ; diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 9ed39ec7d6..cee2358f67 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -57,7 +57,7 @@ M: not-a-month summary @@ -93,7 +93,7 @@ CONSTANT: month-abbreviations-hash : month-abbreviation-index ( string -- n ) month-abbreviations-hash ?at - [ throw-not-a-month-abbreviation ] unless ; + [ not-a-month-abbreviation ] unless ; CONSTANT: day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } diff --git a/basis/calendar/format/format.factor b/basis/calendar/format/format.factor index bc07f6e9ee..a7f2c589a0 100644 --- a/basis/calendar/format/format.factor +++ b/basis/calendar/format/format.factor @@ -202,7 +202,7 @@ M: timestamp year. ( timestamp -- ) ERROR: invalid-timestamp-format ; : check-timestamp ( obj/f -- obj ) - [ throw-invalid-timestamp-format ] unless* ; + [ invalid-timestamp-format ] unless* ; : read-token ( seps -- token ) [ read-until ] keep member? check-timestamp drop ; diff --git a/basis/checksums/openssl/openssl.factor b/basis/checksums/openssl/openssl.factor index c8eab9a95e..41c8537d45 100644 --- a/basis/checksums/openssl/openssl.factor +++ b/basis/checksums/openssl/openssl.factor @@ -33,7 +33,7 @@ M: evp-md-context dispose* : digest-named ( name -- md ) dup EVP_get_digestbyname - [ ] [ throw-unknown-digest ] ?if ; + [ ] [ unknown-digest ] ?if ; : set-digest ( name ctx -- ) handle>> swap digest-named f EVP_DigestInit_ex ssl-error ; diff --git a/basis/classes/struct/struct.factor b/basis/classes/struct/struct.factor index dc742c72c0..63c3fd159c 100644 --- a/basis/classes/struct/struct.factor +++ b/basis/classes/struct/struct.factor @@ -285,7 +285,7 @@ M: struct binary-zero? binary-object uchar [ 0 = ] all? ; inlin :: (define-struct-class) ( class slot-specs offsets-quot alignment-quot -- ) slot-specs check-struct-slots - slot-specs empty? [ throw-struct-must-have-slots ] when + slot-specs empty? [ struct-must-have-slots ] when class redefine-struct-tuple-class slot-specs offsets-quot call :> unaligned-size slot-specs alignment-quot call :> alignment @@ -376,7 +376,7 @@ PRIVATE> scan-token { { ";" [ f ] } { "{" [ parse-struct-slot suffix! t ] } - [ throw-invalid-struct-slot ] + [ invalid-struct-slot ] } case ; : parse-struct-definition ( -- class slots ) @@ -413,7 +413,7 @@ SYNTAX: S@ scan-token { { ";" [ f ] } { "{" [ parse-struct-slot` t ] } - [ throw-invalid-struct-slot ] + [ invalid-struct-slot ] } case ; PRIVATE> diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor index 058062d900..0b641b5c01 100644 --- a/basis/cocoa/messages/messages.factor +++ b/basis/cocoa/messages/messages.factor @@ -67,7 +67,7 @@ ERROR: no-objc-method name ; objc-methods get at ; : lookup-method ( selector -- method ) - dup ?lookup-method [ ] [ throw-no-objc-method ] ?if ; + dup ?lookup-method [ ] [ no-objc-method ] ?if ; : lookup-sender ( name -- method ) lookup-method message-senders get at ; @@ -196,7 +196,7 @@ ERROR: no-objc-type name ; : decode-type ( ch -- ctype ) 1string dup objc>alien-types get at - [ ] [ throw-no-objc-type ] ?if ; + [ ] [ no-objc-type ] ?if ; : (parse-objc-type) ( i string -- ctype ) [ [ 1 + ] dip ] [ nth ] 2bi { diff --git a/basis/cocoa/plists/plists.factor b/basis/cocoa/plists/plists.factor index 2c2dd1ce1a..dccb43d026 100644 --- a/basis/cocoa/plists/plists.factor +++ b/basis/cocoa/plists/plists.factor @@ -58,7 +58,7 @@ ERROR: invalid-plist-object object ; { NSArray [ (plist-NSArray>) ] } { NSDictionary [ (plist-NSDictionary>) ] } { NSObject [ ] } - [ throw-invalid-plist-object ] + [ invalid-plist-object ] } objc-class-case ; : read-plist ( path -- assoc ) diff --git a/basis/colors/constants/constants.factor b/basis/colors/constants/constants.factor index 60eefab882..ad489a51a2 100644 --- a/basis/colors/constants/constants.factor +++ b/basis/colors/constants/constants.factor @@ -28,6 +28,6 @@ PRIVATE> ERROR: no-such-color name ; : named-color ( name -- color ) - dup colors at [ ] [ throw-no-such-color ] ?if ; + dup colors at [ ] [ no-such-color ] ?if ; SYNTAX: COLOR: scan-token named-color suffix! ; diff --git a/basis/combinators/random/random.factor b/basis/combinators/random/random.factor index 5422a9c679..661ed3f08d 100644 --- a/basis/combinators/random/random.factor +++ b/basis/combinators/random/random.factor @@ -35,7 +35,7 @@ M: bad-probabilities summary dup good-probabilities? [ [ dup pair? [ prepare-pair ] [ with-drop ] if ] map cond>quot - ] [ throw-bad-probabilities ] if ; + ] [ bad-probabilities ] if ; MACRO: (casep) ( assoc -- quot ) (casep>quot) ; diff --git a/basis/combinators/short-circuit/smart/smart.factor b/basis/combinators/short-circuit/smart/smart.factor index b2f2a6e1de..7264a07917 100644 --- a/basis/combinators/short-circuit/smart/smart.factor +++ b/basis/combinators/short-circuit/smart/smart.factor @@ -8,7 +8,7 @@ ERROR: cannot-determine-arity ; : arity ( quots -- n ) first infer - dup terminated?>> [ throw-cannot-determine-arity ] when + dup terminated?>> [ cannot-determine-arity ] when effect-height neg 1 + ; PRIVATE> diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index b1462a76fa..9243af28d2 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -67,7 +67,7 @@ ERROR: vreg-not-new vreg ; :: set-ac ( vreg ac -- ) #! Set alias class of newly-seen vreg. - vreg vregs>acs get key? [ vreg throw-vreg-not-new ] when + vreg vregs>acs get key? [ vreg vreg-not-new ] when ac vreg vregs>acs get set-at vreg ac ac>vregs push ; diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 9416033400..23c5b25b6d 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -7,7 +7,7 @@ ERROR: bad-successors ; : check-successors ( bb -- ) dup successors>> [ predecessors>> member-eq? ] with all? - [ throw-bad-successors ] unless ; + [ bad-successors ] unless ; : check-cfg ( cfg -- ) [ check-successors ] each-basic-block ; diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index aaace50e56..24b7e05bdc 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -28,7 +28,7 @@ ERROR: inline-intrinsics-not-supported word quot ; : enable-intrinsics ( alist -- ) [ - over inline? [ throw-inline-intrinsics-not-supported ] when + over inline? [ inline-intrinsics-not-supported ] when "intrinsic" set-word-prop ] assoc-each ; diff --git a/basis/compiler/cfg/intrinsics/simd/backend/backend.factor b/basis/compiler/cfg/intrinsics/simd/backend/backend.factor index c462a528ad..9233e26885 100644 --- a/basis/compiler/cfg/intrinsics/simd/backend/backend.factor +++ b/basis/compiler/cfg/intrinsics/simd/backend/backend.factor @@ -121,7 +121,7 @@ MACRO: if-literals-match ( quots -- quot ) ! node literals quot [ _ firstn ] dip call drop - ] [ 2drop throw-bad-simd-intrinsic ] if + ] [ 2drop bad-simd-intrinsic ] if ] ; CONSTANT: [unary] [ ds-drop ds-pop ] diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index 778fd0a1ec..81924ad4cc 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -12,7 +12,7 @@ ERROR: bad-live-ranges interval ; : check-ranges ( live-interval -- ) check-allocation? get [ dup ranges>> [ [ from>> ] [ to>> ] bi <= ] all? - [ drop ] [ throw-bad-live-ranges ] if + [ drop ] [ bad-live-ranges ] if ] [ drop ] if ; : trim-before-ranges ( live-interval -- ) diff --git a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor index 1914c13cf0..6db04c7d84 100644 --- a/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor +++ b/basis/compiler/cfg/linear-scan/allocation/splitting/splitting.factor @@ -40,11 +40,11 @@ ERROR: splitting-atomic-interval ; : check-split ( live-interval n -- ) check-allocation? get [ - [ [ start>> ] dip > [ throw-splitting-too-early ] when ] - [ [ end>> ] dip < [ throw-splitting-too-late ] when ] + [ [ start>> ] dip > [ splitting-too-early ] when ] + [ [ end>> ] dip < [ splitting-too-late ] when ] [ drop [ end>> ] [ start>> ] bi = - [ throw-splitting-atomic-interval ] when + [ splitting-atomic-interval ] when ] 2tri ] [ 2drop ] if ; inline diff --git a/basis/compiler/cfg/linear-scan/allocation/state/state.factor b/basis/compiler/cfg/linear-scan/allocation/state/state.factor index 664956d776..0ab2b9060b 100644 --- a/basis/compiler/cfg/linear-scan/allocation/state/state.factor +++ b/basis/compiler/cfg/linear-scan/allocation/state/state.factor @@ -71,7 +71,7 @@ ERROR: register-already-used live-interval ; : check-activate ( live-interval -- ) check-allocation? get [ dup [ reg>> ] [ active-intervals-for [ reg>> ] map ] bi member? - [ throw-register-already-used ] [ drop ] if + [ register-already-used ] [ drop ] if ] [ drop ] if ; : activate ( n live-interval -- keep? ) diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index c85278c1f6..e40b41c6b6 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -30,7 +30,7 @@ ERROR: not-spilled-error vreg ; : vreg>spill-slot ( vreg -- spill-slot ) dup vreg>reg dup spill-slot? [ nip ] - [ drop leader throw-not-spilled-error ] if ; + [ drop leader not-spilled-error ] if ; : vregs>regs ( vregs -- assoc ) [ dup vreg>reg ] H{ } map>assoc ; diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index 305bc9777f..f7f54cde10 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -172,7 +172,7 @@ M: hairy-clobber-insn compute-live-intervals* ( insn -- ) ERROR: bad-live-interval live-interval ; : check-start ( live-interval -- ) - dup start>> -1 = [ throw-bad-live-interval ] [ drop ] if ; + dup start>> -1 = [ bad-live-interval ] [ drop ] if ; : finish-live-intervals ( live-intervals -- ) [ diff --git a/basis/compiler/cfg/linear-scan/numbering/numbering.factor b/basis/compiler/cfg/linear-scan/numbering/numbering.factor index dda239d642..cf61de5ef3 100644 --- a/basis/compiler/cfg/linear-scan/numbering/numbering.factor +++ b/basis/compiler/cfg/linear-scan/numbering/numbering.factor @@ -18,7 +18,7 @@ ERROR: bad-numbering bb ; : check-block-numbering ( bb -- ) dup instructions>> [ insn#>> ] map sift [ <= ] monotonic? - [ drop ] [ throw-bad-numbering ] if ; + [ drop ] [ bad-numbering ] if ; : check-numbering ( cfg -- ) check-numbering? get diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor index c1d6246e26..480ce70d86 100644 --- a/basis/compiler/cfg/registers/registers.factor +++ b/basis/compiler/cfg/registers/registers.factor @@ -16,7 +16,7 @@ SYMBOL: representations ERROR: bad-vreg vreg ; : rep-of ( vreg -- rep ) - representations get ?at [ throw-bad-vreg ] unless ; + representations get ?at [ bad-vreg ] unless ; : set-rep-of ( rep vreg -- ) representations get set-at ; diff --git a/basis/compiler/cfg/representations/conversion/conversion.factor b/basis/compiler/cfg/representations/conversion/conversion.factor index 01b447a3fe..e01a030495 100644 --- a/basis/compiler/cfg/representations/conversion/conversion.factor +++ b/basis/compiler/cfg/representations/conversion/conversion.factor @@ -77,7 +77,7 @@ M: scalar-rep int>rep ( dst src rep -- ) ! it is allowed... otherwise bail out. [ drop 2dup [ reg-class-of ] bi@ eq? - [ drop ##copy, ] [ throw-bad-conversion ] if + [ drop ##copy, ] [ bad-conversion ] if ] } case ] diff --git a/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor b/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor index e9b6f682ce..c9e88cd83d 100644 --- a/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor +++ b/basis/compiler/cfg/ssa/destruction/coalescing/coalescing.factor @@ -27,7 +27,7 @@ ERROR: vregs-shouldn't-interfere vreg1 vreg2 ; : try-eliminate-copy ( follower leader must? -- ) -rot leaders 2dup = [ 3drop ] [ 2dup vregs-interfere? [ - drop rot [ throw-vregs-shouldn't-interfere ] [ 2drop ] if + drop rot [ vregs-shouldn't-interfere ] [ 2drop ] if ] [ -rot coalesce-vregs drop ] if ] if ; diff --git a/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor b/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor index e3982983ad..73d7a492e2 100644 --- a/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor +++ b/basis/compiler/cfg/ssa/interference/live-ranges/live-ranges.factor @@ -68,6 +68,6 @@ ERROR: bad-kill-index vreg bb ; 2dup live-out? [ 2drop 1/0. ] [ 2dup kill-indices get at at* [ 2nip ] [ drop 2dup live-in? - [ throw-bad-kill-index ] [ 2drop -1/0. ] if + [ bad-kill-index ] [ 2drop -1/0. ] if ] if ] if ; diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor index 985c4a32ce..210c978772 100644 --- a/basis/compiler/cfg/stacks/finalize/finalize.factor +++ b/basis/compiler/cfg/stacks/finalize/finalize.factor @@ -24,7 +24,7 @@ ERROR: bad-peek dst loc ; : insert-peeks ( from to -- ) [ inserting-peeks ] keep - [ dup n>> 0 < [ throw-bad-peek ] [ ##peek, ] if ] each-insertion ; + [ dup n>> 0 < [ bad-peek ] [ ##peek, ] if ] each-insertion ; : insert-replaces ( from to -- ) [ inserting-replaces ] keep diff --git a/basis/compiler/cfg/stacks/padding/padding.factor b/basis/compiler/cfg/stacks/padding/padding.factor index 79d8448834..78bd22dad0 100644 --- a/basis/compiler/cfg/stacks/padding/padding.factor +++ b/basis/compiler/cfg/stacks/padding/padding.factor @@ -42,7 +42,7 @@ CONSTANT: initial-state { { 0 { } } { 0 { } } } [ register-write ] apply-stack-op ; : ensure-no-vacant ( state -- ) - [ second ] map dup { { } { } } = [ drop ] [ throw-vacant-when-calling ] if ; + [ second ] map dup { { } { } } = [ drop ] [ vacant-when-calling ] if ; : all-live ( state -- state' ) [ first { } 2array ] map ; @@ -68,7 +68,7 @@ ERROR: vacant-peek insn ; : underflowable-peek? ( state peek -- ? ) 2dup loc>> >loc< swap [ 0 1 ? swap nth ] dip classify-read - dup 2 = [ drop throw-vacant-peek ] [ 2nip 1 = ] if ; + dup 2 = [ drop vacant-peek ] [ 2nip 1 = ] if ; M: ##peek visit-insn ( state insn -- state ) dup loc>> n>> 0 >= t assert= diff --git a/basis/compiler/tests/intrinsics.factor b/basis/compiler/tests/intrinsics.factor index 95ae1674c5..78a6b5ee7a 100644 --- a/basis/compiler/tests/intrinsics.factor +++ b/basis/compiler/tests/intrinsics.factor @@ -319,7 +319,7 @@ ERROR: bug-in-fixnum* x y a b ; 32 random-bits >fixnum 32 random-bits >fixnum 2dup [ fixnum* ] [ compiled-fixnum* ] 2bi 2dup = - [ 4drop ] [ throw-bug-in-fixnum* ] if + [ 4drop ] [ bug-in-fixnum* ] if ] times ] unit-test diff --git a/basis/compiler/tree/checker/checker.factor b/basis/compiler/tree/checker/checker.factor index bc616fe8c8..a099e79890 100644 --- a/basis/compiler/tree/checker/checker.factor +++ b/basis/compiler/tree/checker/checker.factor @@ -11,11 +11,11 @@ IN: compiler.tree.checker ERROR: check-use-error value message ; : check-use ( value uses -- ) - [ empty? [ "No use" throw-check-use-error ] [ drop ] if ] + [ empty? [ "No use" check-use-error ] [ drop ] if ] [ all-unique? [ drop ] - [ "Uses not all unique" throw-check-use-error ] if + [ "Uses not all unique" check-use-error ] if ] 2bi ; : check-def-use ( -- ) @@ -62,7 +62,7 @@ ERROR: check-node-error node error ; [ node-defs-values check-values ] [ check-node* ] tri - ] [ throw-check-node-error ] recover ; + ] [ check-node-error ] recover ; SYMBOL: datastack SYMBOL: retainstack diff --git a/basis/compiler/tree/def-use/def-use.factor b/basis/compiler/tree/def-use/def-use.factor index 786e276def..d572ba0965 100644 --- a/basis/compiler/tree/def-use/def-use.factor +++ b/basis/compiler/tree/def-use/def-use.factor @@ -18,7 +18,7 @@ TUPLE: definition value node uses ; ERROR: no-def-error value ; : (def-of) ( value def-use -- definition ) - ?at [ throw-no-def-error ] unless ; inline + ?at [ no-def-error ] unless ; inline : def-of ( value -- definition ) def-use get (def-of) ; @@ -27,7 +27,7 @@ ERROR: multiple-defs-error ; : (def-value) ( node value def-use -- ) 2dup key? [ - throw-multiple-defs-error + multiple-defs-error ] [ [ [ ] keep ] dip set-at ] if ; inline diff --git a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor index b7ad8189fe..26f68dc6c9 100644 --- a/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor +++ b/basis/compiler/tree/propagation/call-effect/call-effect-tests.factor @@ -43,7 +43,7 @@ IN: compiler.tree.propagation.call-effect.tests 2dip rot [ 2drop ] - [ throw-wrong-values ] + [ wrong-values ] if ] ( obj -- a b c ) diff --git a/basis/compiler/tree/propagation/call-effect/call-effect.factor b/basis/compiler/tree/propagation/call-effect/call-effect.factor index dab787c688..361bb01286 100644 --- a/basis/compiler/tree/propagation/call-effect/call-effect.factor +++ b/basis/compiler/tree/propagation/call-effect/call-effect.factor @@ -146,14 +146,14 @@ ERROR: uninferable ; : (infer-value) ( value-info -- effect ) dup literal?>> [ literal>> - [ callable? [ throw-uninferable ] unless ] - [ already-inlined-quot? [ throw-uninferable ] when ] - [ safe-infer dup +unknown+ = [ throw-uninferable ] when ] tri + [ callable? [ uninferable ] unless ] + [ already-inlined-quot? [ uninferable ] when ] + [ safe-infer dup +unknown+ = [ uninferable ] when ] tri ] [ dup class>> { { \ curry [ slots>> third (infer-value) remove-effect-input ] } { \ compose [ slots>> last2 [ (infer-value) ] bi@ compose-effects ] } - [ throw-uninferable ] + [ uninferable ] } case ] if ; diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index 971f79be05..05ad2aeed3 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/basis/compiler/tree/propagation/simple/simple.factor @@ -73,7 +73,7 @@ ERROR: invalid-outputs #call infos ; : check-outputs ( #call infos -- infos ) over out-d>> over [ length ] bi@ = - [ nip ] [ throw-invalid-outputs ] if ; + [ nip ] [ invalid-outputs ] if ; : call-outputs-quot ( #call word -- infos ) dupd diff --git a/basis/compiler/tree/propagation/transforms/transforms.factor b/basis/compiler/tree/propagation/transforms/transforms.factor index 749daf9dcd..e95939b378 100644 --- a/basis/compiler/tree/propagation/transforms/transforms.factor +++ b/basis/compiler/tree/propagation/transforms/transforms.factor @@ -164,7 +164,7 @@ ERROR: bad-partial-eval quot word ; : check-effect ( quot word -- ) 2dup [ infer ] [ stack-effect ] bi* effect<= - [ 2drop ] [ throw-bad-partial-eval ] if ; + [ 2drop ] [ bad-partial-eval ] if ; :: define-partial-eval ( word quot n -- ) word [ diff --git a/basis/compression/inflate/inflate.factor b/basis/compression/inflate/inflate.factor index 7b7149c6ff..27e35daef8 100644 --- a/basis/compression/inflate/inflate.factor +++ b/basis/compression/inflate/inflate.factor @@ -17,7 +17,7 @@ ERROR: bad-zlib-header ; 0 assert= 4 data bs:read 8 assert= ! compression method: deflate 4 data bs:read ! log2(max length)-8, 32K max - 7 <= [ throw-bad-zlib-header ] unless + 7 <= [ bad-zlib-header ] unless 5 data bs:seek ! drop check bits 1 data bs:read 0 assert= ! dictionary - not allowed in png 2 data bs:seek ! compression level; ignore @@ -104,7 +104,7 @@ CONSTANT: dist-table dup 285 = [ dup 264 > [ dup 261 - 4 /i - dup 5 > [ throw-bad-zlib-data ] when + dup 5 > [ bad-zlib-data ] when bitstream bs:read 2array ] when ] unless @@ -113,7 +113,7 @@ CONSTANT: dist-table dup 3 > [ dup 2 - 2 /i dup 13 > - [ throw-bad-zlib-data ] when + [ bad-zlib-data ] when bitstream bs:read 2array ] when 2array ] when dup 256 = not @@ -157,7 +157,7 @@ CONSTANT: dist-table { 0 [ inflate-raw ] } { 1 [ inflate-static ] } { 2 [ inflate-dynamic ] } - { 3 [ throw-bad-zlib-data f ] } + { 3 [ bad-zlib-data f ] } } case ] [ produce ] keep call suffix concat ; diff --git a/basis/compression/lzw/lzw.factor b/basis/compression/lzw/lzw.factor index efe026a58e..cb1d70c55e 100755 --- a/basis/compression/lzw/lzw.factor +++ b/basis/compression/lzw/lzw.factor @@ -30,7 +30,7 @@ ERROR: code-size-zero ; : ( input code-size class -- obj ) new - swap [ throw-code-size-zero ] when-zero >>code-size + swap [ code-size-zero ] when-zero >>code-size dup code-size>> >>initial-code-size dup code-size>> 1 - 2^ >>clear-code dup clear-code>> 1 + >>end-of-information-code diff --git a/basis/compression/snappy/snappy.factor b/basis/compression/snappy/snappy.factor index f368ebec3b..590c9d4b71 100644 --- a/basis/compression/snappy/snappy.factor +++ b/basis/compression/snappy/snappy.factor @@ -9,7 +9,7 @@ ERROR: snappy-error error ; outs ( n -- byte-array size_t* ) [ ] [ size_t ] bi ; diff --git a/basis/compression/zlib/zlib.factor b/basis/compression/zlib/zlib.factor index a82352327d..533d55bb68 100644 --- a/basis/compression/zlib/zlib.factor +++ b/basis/compression/zlib/zlib.factor @@ -20,13 +20,13 @@ ERROR: zlib-failed n string ; "stream error" "data error" "memory error" "buffer error" "zlib version error" } ?nth - ] if throw-zlib-failed ; + ] if zlib-failed ; : zlib-error ( n -- ) dup { { compression.zlib.ffi:Z_OK [ drop ] } { compression.zlib.ffi:Z_STREAM_END [ drop ] } - [ dup zlib-error-message throw-zlib-failed ] + [ dup zlib-error-message zlib-failed ] } case ; : compressed-size ( byte-array -- n ) diff --git a/basis/concurrency/conditions/conditions.factor b/basis/concurrency/conditions/conditions.factor index ca72e47e8f..48a685efda 100644 --- a/basis/concurrency/conditions/conditions.factor +++ b/basis/concurrency/conditions/conditions.factor @@ -28,7 +28,7 @@ ERROR: timed-out-error timer ; : wait ( queue timeout status -- ) over [ [ queue-timeout ] dip suspend - [ throw-timed-out-error ] [ stop-timer ] if + [ timed-out-error ] [ stop-timer ] if ] [ [ drop queue ] dip suspend drop ] if ; inline diff --git a/basis/concurrency/count-downs/count-downs.factor b/basis/concurrency/count-downs/count-downs.factor index 0a5891d7e2..c5d1d57985 100755 --- a/basis/concurrency/count-downs/count-downs.factor +++ b/basis/concurrency/count-downs/count-downs.factor @@ -14,7 +14,7 @@ TUPLE: count-down-tuple n promise ; ERROR: invalid-count-down-count count ; : ( n -- count-down ) - dup 0 < [ throw-invalid-count-down-count ] when + dup 0 < [ invalid-count-down-count ] when \ count-down-tuple boa dup count-down-check ; @@ -22,7 +22,7 @@ ERROR: count-down-already-done ; : count-down ( count-down -- ) dup n>> dup zero? - [ throw-count-down-already-done ] + [ count-down-already-done ] [ 1 - >>n count-down-check ] if ; : await-timeout ( count-down timeout -- ) diff --git a/basis/concurrency/messaging/messaging.factor b/basis/concurrency/messaging/messaging.factor index e685f243f6..dc3e810871 100644 --- a/basis/concurrency/messaging/messaging.factor +++ b/basis/concurrency/messaging/messaging.factor @@ -56,7 +56,7 @@ M: cannot-send-synchronous-to-self summary : send-synchronous ( message thread -- reply ) dup self eq? [ - throw-cannot-send-synchronous-to-self + cannot-send-synchronous-to-self ] [ [ dup ] dip send '[ _ synchronous-reply? ] receive-if diff --git a/basis/concurrency/promises/promises.factor b/basis/concurrency/promises/promises.factor index 44e98e2f1a..f47ee05c75 100644 --- a/basis/concurrency/promises/promises.factor +++ b/basis/concurrency/promises/promises.factor @@ -15,7 +15,7 @@ ERROR: promise-already-fulfilled promise ; : fulfill ( value promise -- ) dup promise-fulfilled? [ - throw-promise-already-fulfilled + promise-already-fulfilled ] [ mailbox>> mailbox-put ] if ; diff --git a/basis/concurrency/semaphores/semaphores.factor b/basis/concurrency/semaphores/semaphores.factor index fae9cc576c..392b7557d6 100644 --- a/basis/concurrency/semaphores/semaphores.factor +++ b/basis/concurrency/semaphores/semaphores.factor @@ -12,7 +12,7 @@ M: negative-count-semaphore summary drop "Cannot have semaphore with negative count" ; : ( n -- semaphore ) - dup 0 < [ throw-negative-count-semaphore ] when + dup 0 < [ negative-count-semaphore ] when semaphore boa ; : wait-to-acquire ( semaphore timeout -- ) diff --git a/basis/core-foundation/launch-services/launch-services.factor b/basis/core-foundation/launch-services/launch-services.factor index 9e75dd8680..77a984e75a 100644 --- a/basis/core-foundation/launch-services/launch-services.factor +++ b/basis/core-foundation/launch-services/launch-services.factor @@ -113,7 +113,7 @@ CONSTANT: kLSUnknownCreator f ERROR: core-foundation-error n ; : cf-error ( n -- ) - dup 0 = [ drop ] [ throw-core-foundation-error ] if ; + dup 0 = [ drop ] [ core-foundation-error ] if ; : fsref>string ( fsref -- string ) MAXPATHLEN [ ] [ ] bi diff --git a/basis/core-foundation/numbers/numbers.factor b/basis/core-foundation/numbers/numbers.factor index 08ce305c7a..bdeb3bf017 100644 --- a/basis/core-foundation/numbers/numbers.factor +++ b/basis/core-foundation/numbers/numbers.factor @@ -67,5 +67,5 @@ ERROR: unsupported-number-type type ; { kCFNumberLongType [ long (CFNumber>number) ] } { kCFNumberLongLongType [ longlong (CFNumber>number) ] } { kCFNumberDoubleType [ double (CFNumber>number) ] } - [ throw-unsupported-number-type ] + [ unsupported-number-type ] } case ; diff --git a/basis/core-text/core-text.factor b/basis/core-text/core-text.factor index c4f20998e8..98b6c4a189 100644 --- a/basis/core-text/core-text.factor +++ b/basis/core-text/core-text.factor @@ -45,7 +45,7 @@ MEMO: make-attributes ( open-font color -- hashtable ) [ [ dup selection? [ string>> ] when - dup string? [ throw-not-a-string ] unless + dup string? [ not-a-string ] unless ] 2dip make-attributes &CFRelease CTLineCreateWithAttributedString diff --git a/basis/cpu/x86/assembler/assembler.factor b/basis/cpu/x86/assembler/assembler.factor index b21aeada62..6426af85cd 100644 --- a/basis/cpu/x86/assembler/assembler.factor +++ b/basis/cpu/x86/assembler/assembler.factor @@ -234,14 +234,14 @@ M: operand MOV 0x88 2-operand ; ERROR: bad-movabs-operands dst src ; GENERIC: MOVABS ( dst src -- ) -M: object MOVABS throw-bad-movabs-operands ; +M: object MOVABS bad-movabs-operands ; M: register MOVABS { { AL [ 0xa2 , cell, ] } { AX [ 0x66 , 0xa3 , cell, ] } { EAX [ 0xa3 , cell, ] } { RAX [ 0x48 , 0xa3 , cell, ] } - [ swap throw-bad-movabs-operands ] + [ swap bad-movabs-operands ] } case ; M: integer MOVABS swap { @@ -249,7 +249,7 @@ M: integer MOVABS { AX [ 0x66 , 0xa1 , cell, ] } { EAX [ 0xa1 , cell, ] } { RAX [ 0x48 , 0xa1 , cell, ] } - [ swap throw-bad-movabs-operands ] + [ swap bad-movabs-operands ] } case ; : LEA ( dst src -- ) swap 0x8d 2-operand ; @@ -481,7 +481,7 @@ ERROR: bad-x87-operands ; :: x87-st0-op ( src opcode reg -- ) src register? [ src opcode reg (x87-op) ] - [ throw-bad-x87-operands ] if ; + [ bad-x87-operands ] if ; :: x87-m-st0/n-op ( dst src opcode reg -- ) { @@ -494,7 +494,7 @@ ERROR: bad-x87-operands ; { [ src ST0 = dst register? and ] [ dst opcode 4 + reg (x87-op) ] } - [ throw-bad-x87-operands ] + [ bad-x87-operands ] } cond ; PRIVATE> diff --git a/basis/cpu/x86/assembler/operands/operands.factor b/basis/cpu/x86/assembler/operands/operands.factor index 6368405e65..2a2faa4039 100644 --- a/basis/cpu/x86/assembler/operands/operands.factor +++ b/basis/cpu/x86/assembler/operands/operands.factor @@ -66,7 +66,7 @@ M: indirect extended? base>> extended? ; ERROR: bad-index indirect ; : check-ESP ( indirect -- indirect ) - dup index>> { ESP RSP } member-eq? [ throw-bad-index ] when ; + dup index>> { ESP RSP } member-eq? [ bad-index ] when ; : canonicalize ( indirect -- indirect ) #! Modify the indirect to work around certain addressing mode diff --git a/basis/db/postgresql/lib/lib.factor b/basis/db/postgresql/lib/lib.factor index 2b18514288..7f350d17ee 100644 --- a/basis/db/postgresql/lib/lib.factor +++ b/basis/db/postgresql/lib/lib.factor @@ -37,7 +37,7 @@ M: postgresql-result-null summary ( obj -- str ) drop "PQexec returned f." ; : postgresql-result-ok? ( res -- ? ) - [ throw-postgresql-result-null ] unless* + [ postgresql-result-null ] unless* PQresultStatus PGRES_COMMAND_OK PGRES_TUPLES_OK 2array member? ; diff --git a/basis/db/postgresql/postgresql.factor b/basis/db/postgresql/postgresql.factor index 837cd414f5..12acded9c0 100644 --- a/basis/db/postgresql/postgresql.factor +++ b/basis/db/postgresql/postgresql.factor @@ -278,7 +278,7 @@ M: postgresql-db-connection compound ( string object -- string' ) { "default" [ first number>string " " glue ] } { "varchar" [ first number>string "(" ")" surround append ] } { "references" [ >reference-string ] } - [ drop throw-no-compound-found ] + [ drop no-compound-found ] } case ; M: postgresql-db-connection parse-db-error diff --git a/basis/db/queries/queries.factor b/basis/db/queries/queries.factor index 5b7a91eefb..fb3a7e107a 100644 --- a/basis/db/queries/queries.factor +++ b/basis/db/queries/queries.factor @@ -158,7 +158,7 @@ M: db-connection ( tuple class -- statement ) [ "select " 0% [ dupd filter-ignores ] dip - over empty? [ throw-all-slots-ignored ] when + over empty? [ all-slots-ignored ] when over [ ", " 0% ] [ dup column-name>> 0% 2, ] interleave diff --git a/basis/db/sqlite/lib/lib.factor b/basis/db/sqlite/lib/lib.factor index 35ebfb12f7..1f954688be 100644 --- a/basis/db/sqlite/lib/lib.factor +++ b/basis/db/sqlite/lib/lib.factor @@ -12,11 +12,11 @@ ERROR: sqlite-error < db-error n string ; ERROR: sqlite-sql-error < sql-error n string ; : sqlite-other-error ( n -- * ) - dup sqlite-error-messages nth throw-sqlite-error ; + dup sqlite-error-messages nth sqlite-error ; : sqlite-statement-error ( -- * ) SQLITE_ERROR - db-connection get handle>> sqlite3_errmsg throw-sqlite-sql-error ; + db-connection get handle>> sqlite3_errmsg sqlite-sql-error ; : sqlite-check-result ( n -- ) { diff --git a/basis/db/sqlite/sqlite.factor b/basis/db/sqlite/sqlite.factor index 8131e18d3c..9005b48f17 100644 --- a/basis/db/sqlite/sqlite.factor +++ b/basis/db/sqlite/sqlite.factor @@ -100,7 +100,7 @@ ERROR: sqlite-last-id-fail ; : last-insert-id ( -- id ) db-connection get handle>> sqlite3_last_insert_rowid - dup zero? [ throw-sqlite-last-id-fail ] when ; + dup zero? [ sqlite-last-id-fail ] when ; M: sqlite-db-connection insert-tuple-set-key ( tuple statement -- ) execute-statement last-insert-id swap set-primary-key ; diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index ac010e5a66..0bdb2978ee 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -78,7 +78,7 @@ ERROR: no-slots-named class seq ; [ keys ] [ all-slots [ name>> ] map ] bi* diff ] 2bi - [ drop ] [ throw-no-slots-named ] if-empty ; + [ drop ] [ no-slots-named ] if-empty ; : define-persistent ( class table columns -- ) pick dupd @@ -103,7 +103,7 @@ ERROR: no-defined-persistent object ; : ensure-defined-persistent ( object -- object ) dup { [ class? ] [ "db-table" word-prop ] } 1&& [ - throw-no-defined-persistent + no-defined-persistent ] unless ; : create-table ( class -- ) diff --git a/basis/db/types/types.factor b/basis/db/types/types.factor index 5b92512d60..5fb86e5ea9 100644 --- a/basis/db/types/types.factor +++ b/basis/db/types/types.factor @@ -38,7 +38,7 @@ SYMBOL: IGNORE ERROR: not-persistent class ; : db-table-name ( class -- object ) - dup "db-table" word-prop [ ] [ throw-not-persistent ] ?if ; + dup "db-table" word-prop [ ] [ not-persistent ] ?if ; : db-columns ( class -- object ) superclasses-of [ "db-columns" word-prop ] map concat ; @@ -117,13 +117,13 @@ ERROR: unknown-modifier modifier ; : lookup-modifier ( obj -- string ) { { [ dup array? ] [ unclip lookup-modifier swap compound ] } - [ persistent-table ?at [ throw-unknown-modifier ] unless third ] + [ persistent-table ?at [ unknown-modifier ] unless third ] } cond ; ERROR: no-sql-type type ; : (lookup-type) ( obj -- string ) - persistent-table ?at [ throw-no-sql-type ] unless ; + persistent-table ?at [ no-sql-type ] unless ; : lookup-type ( obj -- string ) dup array? [ @@ -152,5 +152,5 @@ ERROR: no-column column ; first2 [ [ db-table-name " " glue ] [ db-columns ] bi ] dip swap [ column-name>> = ] with find nip - [ throw-no-column ] unless* + [ no-column ] unless* column-name>> "(" ")" surround append ; diff --git a/basis/delegate/delegate.factor b/basis/delegate/delegate.factor index 1faf570e97..6a18de6c0e 100644 --- a/basis/delegate/delegate.factor +++ b/basis/delegate/delegate.factor @@ -38,7 +38,7 @@ M: tuple-class group-words : check-broadcast-group ( group -- group ) dup group-words [ first stack-effect out>> empty? ] all? - [ throw-broadcast-words-must-have-no-outputs ] unless ; + [ broadcast-words-must-have-no-outputs ] unless ; ! Consultation @@ -160,7 +160,7 @@ ERROR: not-a-generic word ; : check-generic ( generic -- ) dup array? [ first ] when - dup generic? [ drop ] [ throw-not-a-generic ] if ; + dup generic? [ drop ] [ not-a-generic ] if ; PRIVATE> diff --git a/basis/deques/deques.factor b/basis/deques/deques.factor index 79fc81c5b5..8ecde83a14 100644 --- a/basis/deques/deques.factor +++ b/basis/deques/deques.factor @@ -18,13 +18,13 @@ GENERIC: deque-empty? ( deque -- ? ) ERROR: empty-deque ; : peek-front ( deque -- obj ) - peek-front* [ drop throw-empty-deque ] unless ; + peek-front* [ drop empty-deque ] unless ; : ?peek-front ( deque -- obj/f ) peek-front* [ drop f ] unless ; : peek-back ( deque -- obj ) - peek-back* [ drop throw-empty-deque ] unless ; + peek-back* [ drop empty-deque ] unless ; : ?peek-back ( deque -- obj/f ) peek-back* [ drop f ] unless ; diff --git a/basis/editors/editors.factor b/basis/editors/editors.factor index 85b7484247..fe21dfe4df 100644 --- a/basis/editors/editors.factor +++ b/basis/editors/editors.factor @@ -37,7 +37,7 @@ M: object editor-detached? t ; ERROR: invalid-location file line ; : edit-location ( file line -- ) - over [ throw-invalid-location ] unless + over [ invalid-location ] unless [ absolute-path ] dip editor-command [ run-and-wait-for-editor ] when* ; @@ -66,7 +66,7 @@ PRIVATE> GENERIC: edit ( object -- ) M: object edit - dup where [ first2 edit-location ] [ throw-cannot-find-source ] ?if ; + dup where [ first2 edit-location ] [ cannot-find-source ] ?if ; M: string edit edit-vocab ; diff --git a/basis/formatting/formatting.factor b/basis/formatting/formatting.factor index 2cc26266dc..f36b042622 100644 --- a/basis/formatting/formatting.factor +++ b/basis/formatting/formatting.factor @@ -72,7 +72,7 @@ fmt-E = digits "E" => [[ first '[ _ format-scientific >upper ] ]] fmt-f = digits "f" => [[ first '[ _ format-decimal ] ]] fmt-x = "x" => [[ [ >hex ] ]] fmt-X = "X" => [[ [ >hex >upper ] ]] -unknown = (.)* => [[ throw-unknown-printf-directive ]] +unknown = (.)* => [[ unknown-printf-directive ]] strings_ = fmt-c|fmt-C|fmt-s|fmt-S|fmt-u strings = pad width strings_ => [[ compose-all ]] diff --git a/basis/fry/fry.factor b/basis/fry/fry.factor index 2b447fa4db..cca4aef3b5 100644 --- a/basis/fry/fry.factor +++ b/basis/fry/fry.factor @@ -15,7 +15,7 @@ GENERIC: fry ( quot -- quot' ) : check-fry ( quot -- quot ) dup { load-local load-locals get-local drop-locals } intersect - [ throw->r/r>-in-fry-error ] unless-empty ; + [ >r/r>-in-fry-error ] unless-empty ; PREDICATE: fry-specifier < word { _ @ } member-eq? ; diff --git a/basis/ftp/client/client.factor b/basis/ftp/client/client.factor index b676798fb0..c94d5a273a 100644 --- a/basis/ftp/client/client.factor +++ b/basis/ftp/client/client.factor @@ -28,7 +28,7 @@ IN: ftp.client ERROR: ftp-error got expected ; : ftp-assert ( ftp-response n -- ) - 2dup [ n>> ] dip = [ 2drop ] [ throw-ftp-error ] if ; + 2dup [ n>> ] dip = [ 2drop ] [ ftp-error ] if ; : ftp-command ( string -- ftp-response ) ftp-send read-response ; diff --git a/basis/ftp/server/server.factor b/basis/ftp/server/server.factor index f3d4b70889..63ceec6d76 100644 --- a/basis/ftp/server/server.factor +++ b/basis/ftp/server/server.factor @@ -111,7 +111,7 @@ ERROR: type-error type ; >upper { { "IMAGE" [ "Binary" ] } { "I" [ "Binary" ] } - [ throw-type-error ] + [ type-error ] } case ; : handle-TYPE ( obj -- ) diff --git a/basis/furnace/asides/asides.factor b/basis/furnace/asides/asides.factor index 76f9e675c4..4f2568b636 100644 --- a/basis/furnace/asides/asides.factor +++ b/basis/furnace/asides/asides.factor @@ -77,7 +77,7 @@ M: asides call-responder* ERROR: end-aside-in-get-error ; : move-on ( id -- response ) - post-request? [ throw-end-aside-in-get-error ] unless + post-request? [ end-aside-in-get-error ] unless dup method>> { { "GET" [ url>> ] } { "HEAD" [ url>> ] } diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor index 0826bf9e7b..57a6919ae9 100644 --- a/basis/furnace/utilities/utilities.factor +++ b/basis/furnace/utilities/utilities.factor @@ -16,7 +16,7 @@ ERROR: no-such-word name vocab ; : string>word ( string -- word ) ":" split1 swap 2dup lookup-word dup - [ 2nip ] [ drop throw-no-such-word ] if ; + [ 2nip ] [ drop no-such-word ] if ; : strings>words ( seq -- seq' ) [ string>word ] map ; @@ -32,7 +32,7 @@ ERROR: no-such-responder responder ; : base-path ( string -- seq ) dup responder-nesting get [ second class-of superclasses-of [ name>> = ] with any? ] with find nip - [ first ] [ throw-no-such-responder ] ?if ; + [ first ] [ no-such-responder ] ?if ; : resolve-base-path ( string -- string' ) "$" ?head [ diff --git a/basis/game/input/input.factor b/basis/game/input/input.factor index a4395aaaf8..e46587f5ba 100644 --- a/basis/game/input/input.factor +++ b/basis/game/input/input.factor @@ -50,7 +50,7 @@ ERROR: game-input-not-open ; reset-mouse ; : close-game-input ( -- ) game-input-opened [ - dup zero? [ throw-game-input-not-open ] when + dup zero? [ game-input-not-open ] when 1 - ] change-global game-input-opened? [ diff --git a/basis/generalizations/generalizations.factor b/basis/generalizations/generalizations.factor index 49be966f0e..91b42d5a83 100644 --- a/basis/generalizations/generalizations.factor +++ b/basis/generalizations/generalizations.factor @@ -28,7 +28,7 @@ ERROR: nonpositive-npick n ; MACRO: npick ( n -- quot ) { - { [ dup 0 <= ] [ throw-nonpositive-npick ] } + { [ dup 0 <= ] [ nonpositive-npick ] } { [ dup 1 = ] [ drop [ dup ] ] } [ 1 - [ dup ] [ '[ _ dip swap ] ] repeat ] } cond ; diff --git a/basis/gobject-introspection/gobject-introspection.factor b/basis/gobject-introspection/gobject-introspection.factor index 61646275c8..3d380cb68b 100755 --- a/basis/gobject-introspection/gobject-introspection.factor +++ b/basis/gobject-introspection/gobject-introspection.factor @@ -39,7 +39,7 @@ M: gir-not-found summary current-vocab-dirs custom-gir-dirs system-gir-dirs 3append sift :> paths paths [ path append-path exists? ] find nip - [ path append-path ] [ path paths throw-gir-not-found ] if* + [ path append-path ] [ path paths gir-not-found ] if* ] if ; : define-gir-vocab ( path -- ) diff --git a/basis/gobject-introspection/types/types.factor b/basis/gobject-introspection/types/types.factor index 1d975523a4..cd244cf9aa 100644 --- a/basis/gobject-introspection/types/types.factor +++ b/basis/gobject-introspection/types/types.factor @@ -79,7 +79,7 @@ ERROR: unknown-type-error type ; : get-type-info ( data-type -- info ) qualified-type-name dup type-infos get-global at - [ ] [ throw-unknown-type-error ] ?if ; + [ ] [ unknown-type-error ] ?if ; : find-type-info ( data-type -- info/f ) qualified-type-name type-infos get-global at ; @@ -105,8 +105,8 @@ ERROR: deferred-type-error ; << void* lookup-c-type clone - [ drop throw-deferred-type-error ] >>unboxer-quot - [ drop throw-deferred-type-error ] >>boxer-quot + [ drop deferred-type-error ] >>unboxer-quot + [ drop deferred-type-error ] >>boxer-quot object >>boxed-class "deferred-type" create-word-in typedef >> diff --git a/basis/grouping/grouping.factor b/basis/grouping/grouping.factor index 00cc454ee9..233d793483 100644 --- a/basis/grouping/grouping.factor +++ b/basis/grouping/grouping.factor @@ -57,7 +57,7 @@ M: abstract-clumps group@ TUPLE: chunking-seq { seq read-only } { n read-only } ; : check-groups ( seq n -- seq n ) - dup 0 <= [ throw-groups-error ] when ; inline + dup 0 <= [ groups-error ] when ; inline : new-groups ( seq n class -- groups ) [ check-groups ] dip boa ; inline diff --git a/basis/heaps/heaps.factor b/basis/heaps/heaps.factor index 3f41c1bc26..b92bfe3668 100644 --- a/basis/heaps/heaps.factor +++ b/basis/heaps/heaps.factor @@ -24,7 +24,7 @@ TUPLE: heap { data vector } ; ERROR: not-a-heap object ; : check-heap ( heap -- heap ) - dup heap? [ throw-not-a-heap ] unless ; inline + dup heap? [ not-a-heap ] unless ; inline TUPLE: entry value key heap index ; @@ -164,7 +164,7 @@ M: bad-heap-delete summary index ( entry heap -- n ) - over heap>> eq? [ throw-bad-heap-delete ] unless + over heap>> eq? [ bad-heap-delete ] unless index>> { fixnum } declare ; inline PRIVATE> diff --git a/basis/help/lint/checks/checks.factor b/basis/help/lint/checks/checks.factor index b94aa677d7..0133e3b7c8 100644 --- a/basis/help/lint/checks/checks.factor +++ b/basis/help/lint/checks/checks.factor @@ -30,7 +30,7 @@ SYMBOL: vocab-articles last assert= ] vocabs-quot get call( quot -- ) ] leaks members length [ - "%d disposable(s) leaked in example" sprintf throw-simple-lint-error + "%d disposable(s) leaked in example" sprintf simple-lint-error ] unless-zero ; : check-examples ( element -- ) @@ -88,7 +88,7 @@ SYMBOL: vocab-articles [ effect-values ] [ extract-values ] bi* 2dup sequence= [ 2drop ] [ "$values don't match stack effect; expected %u, got %u" sprintf - throw-simple-lint-error + simple-lint-error ] if ] if ; @@ -96,17 +96,17 @@ SYMBOL: vocab-articles [ effect-effects ] [ extract-value-effects ] bi* [ 2dup and [ = ] [ 2drop t ] if ] 2all? [ "$quotation stack effects in $values don't match" - throw-simple-lint-error + simple-lint-error ] unless ; : check-nulls ( element -- ) \ $values swap elements null swap deep-member? - [ "$values should not contain null" throw-simple-lint-error ] when ; + [ "$values should not contain null" simple-lint-error ] when ; : check-see-also ( element -- ) \ $see-also swap elements [ rest all-unique? ] all? - [ "$see-also are not unique" throw-simple-lint-error ] unless ; + [ "$see-also are not unique" simple-lint-error ] unless ; : vocab-exists? ( name -- ? ) [ lookup-vocab ] [ all-vocabs-list get member? ] bi or ; @@ -116,7 +116,7 @@ SYMBOL: vocab-articles second vocab-exists? [ "$vocab-link to non-existent vocabulary" - throw-simple-lint-error + simple-lint-error ] unless ] each ; @@ -127,23 +127,23 @@ SYMBOL: vocab-articles [ "\n\t" intersects? [ "Paragraph text should not contain \\n or \\t" - throw-simple-lint-error + simple-lint-error ] when ] [ " " swap subseq? [ "Paragraph text should not contain double spaces" - throw-simple-lint-error + simple-lint-error ] when ] bi ; : check-whitespace ( str1 str2 -- ) [ " " tail? ] [ " " head? ] bi* or - [ "Missing whitespace between strings" throw-simple-lint-error ] unless ; + [ "Missing whitespace between strings" simple-lint-error ] unless ; : check-bogus-nl ( element -- ) { { $nl } { { $nl } } } [ head? ] with any? [ "Simple element should not begin with a paragraph break" - throw-simple-lint-error + simple-lint-error ] when ; : extract-slots ( elements -- seq ) @@ -158,18 +158,18 @@ SYMBOL: vocab-articles ] [ extract-slots ] bi* [ swap member? ] with reject [ ", " join "Described $slot does not exist: " prepend - throw-simple-lint-error + simple-lint-error ] unless-empty ] [ nip empty? not [ "A word that is not a class has a $class-description" - throw-simple-lint-error + simple-lint-error ] when ] if ; : check-article-title ( article -- ) article-title first LETTER? - [ "Article title must begin with a capital letter" throw-simple-lint-error ] unless ; + [ "Article title must begin with a capital letter" simple-lint-error ] unless ; : check-elements ( element -- ) { @@ -184,7 +184,7 @@ SYMBOL: vocab-articles swap '[ _ elements [ rest { { } { "" } } member? - [ "Empty $description" throw-simple-lint-error ] when + [ "Empty $description" simple-lint-error ] when ] each ] each ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index 799e45f45b..61b16ab746 100644 --- a/basis/help/markup/markup.factor +++ b/basis/help/markup/markup.factor @@ -210,11 +210,11 @@ M: word link-long-text ERROR: number-of-arguments found required ; : check-first ( seq -- first ) - dup length 1 = [ length 1 throw-number-of-arguments ] unless + dup length 1 = [ length 1 number-of-arguments ] unless first-unsafe ; : check-first2 ( seq -- first second ) - dup length 2 = [ length 2 throw-number-of-arguments ] unless + dup length 2 = [ length 2 number-of-arguments ] unless first2-unsafe ; PRIVATE> diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor index 505cd67344..74c14e1f87 100644 --- a/basis/help/syntax/syntax.factor +++ b/basis/help/syntax/syntax.factor @@ -15,7 +15,7 @@ ERROR: article-expects-name-and-title got ; SYNTAX: ARTICLE: location [ \ ; parse-until >array - dup length 2 < [ throw-article-expects-name-and-title ] when + dup length 2 < [ article-expects-name-and-title ] when [ first2 ] [ 2 tail ] bi
over add-article >link ] dip remember-definition ; diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor index 3f80275fc5..995fcbca52 100644 --- a/basis/help/topics/topics.factor +++ b/basis/help/topics/topics.factor @@ -63,7 +63,7 @@ M: no-article summary drop "Help article does not exist" ; : lookup-article ( name -- article ) - articles get ?at [ throw-no-article ] unless ; + articles get ?at [ no-article ] unless ; M: object valid-article? articles get key? ; M: object article-title lookup-article article-title ; diff --git a/basis/hints/hints.factor b/basis/hints/hints.factor index 3e84da8286..b5b41603d2 100644 --- a/basis/hints/hints.factor +++ b/basis/hints/hints.factor @@ -70,7 +70,7 @@ M: object specializer-declaration class-of ; ERROR: cannot-specialize word specializer ; : set-specializer ( word specializer -- ) - over inline-recursive? [ throw-cannot-specialize ] when + over inline-recursive? [ cannot-specialize ] when "specializer" set-word-prop ; SYNTAX: HINTS: diff --git a/basis/html/templates/chloe/compiler/compiler.factor b/basis/html/templates/chloe/compiler/compiler.factor index 5338c6d387..1c7c73c90f 100644 --- a/basis/html/templates/chloe/compiler/compiler.factor +++ b/basis/html/templates/chloe/compiler/compiler.factor @@ -75,7 +75,7 @@ SYMBOL: string-context? ERROR: tag-not-allowed-here ; : check-tag ( -- ) - string-context? get [ throw-tag-not-allowed-here ] when ; + string-context? get [ tag-not-allowed-here ] when ; : compile-tag ( tag -- ) check-tag diff --git a/basis/html/templates/templates.factor b/basis/html/templates/templates.factor index f6b890c693..fd48d81ecd 100644 --- a/basis/html/templates/templates.factor +++ b/basis/html/templates/templates.factor @@ -39,10 +39,10 @@ M: no-boilerplate error. SYMBOL: title : set-title ( string -- ) - title get [ >box ] [ throw-no-boilerplate ] if* ; + title get [ >box ] [ no-boilerplate ] if* ; : get-title ( -- string ) - title get [ value>> ] [ throw-no-boilerplate ] if* ; + title get [ value>> ] [ no-boilerplate ] if* ; : write-title ( -- ) get-title write ; diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 902d066b7f..b1a9daed1f 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -93,7 +93,7 @@ SYMBOL: redirects response "location" header redirect-url response code>> 307 = [ "GET" >>method ] unless quot (with-http-request) - ] [ throw-too-many-redirects ] if ; inline recursive + ] [ too-many-redirects ] if ; inline recursive : read-chunk-size ( -- n ) read-crlf ";" split1 drop [ blank? ] trim-tail diff --git a/basis/http/server/requests/requests.factor b/basis/http/server/requests/requests.factor index 42804604e9..8348c029ff 100644 --- a/basis/http/server/requests/requests.factor +++ b/basis/http/server/requests/requests.factor @@ -17,10 +17,10 @@ ERROR: content-length-missing < request-error ; ERROR: bad-request-line < request-error parse-error ; : check-absolute ( url -- ) - path>> dup "/" head? [ drop ] [ throw-invalid-path ] if ; inline + path>> dup "/" head? [ drop ] [ invalid-path ] if ; inline : parse-request-line-safe ( string -- triple ) - [ parse-request-line ] [ nip throw-bad-request-line ] recover ; + [ parse-request-line ] [ nip bad-request-line ] recover ; : read-request-line ( request -- request ) read-?crlf [ dup "" = ] [ drop read-?crlf ] while @@ -36,7 +36,7 @@ upload-limit [ 200,000,000 ] initialize : parse-multipart-form-data ( string -- separator ) ";" split1 nip - "=" split1 nip [ throw-no-boundary ] unless* ; + "=" split1 nip [ no-boundary ] unless* ; : maybe-limit-input ( content-length -- ) unlimited-input upload-limit get [ min ] when* limited-input ; @@ -49,10 +49,10 @@ upload-limit [ 200,000,000 ] initialize "content-length" header [ dup string>number [ nip dup 0 upload-limit get between? [ - throw-invalid-content-length + invalid-content-length ] unless - ] [ throw-invalid-content-length ] if* - ] [ throw-content-length-missing ] if* ; + ] [ invalid-content-length ] if* + ] [ content-length-missing ] if* ; : parse-content ( request content-type -- post-data ) dup -rot over parse-content-length-safe swap diff --git a/basis/images/loader/gdiplus/gdiplus.factor b/basis/images/loader/gdiplus/gdiplus.factor index de87bf87c9..6ed16ba3c3 100644 --- a/basis/images/loader/gdiplus/gdiplus.factor +++ b/basis/images/loader/gdiplus/gdiplus.factor @@ -58,7 +58,7 @@ os windows? [ ERROR: unsupported-pixel-format component-order ; : check-pixel-format ( image -- ) - component-order>> dup BGRA = [ drop ] [ throw-unsupported-pixel-format ] if ; + component-order>> dup BGRA = [ drop ] [ unsupported-pixel-format ] if ; : image>gdi+-bitmap ( image -- bitmap ) dup check-pixel-format diff --git a/basis/images/loader/loader.factor b/basis/images/loader/loader.factor index e48a238f80..1496ae00ae 100644 --- a/basis/images/loader/loader.factor +++ b/basis/images/loader/loader.factor @@ -13,7 +13,7 @@ SYMBOL: types types [ H{ } clone ] initialize : (image-class) ( type -- class ) - >lower types get ?at [ throw-unknown-image-extension ] unless ; + >lower types get ?at [ unknown-image-extension ] unless ; : image-class ( path -- class ) file-extension (image-class) ; diff --git a/basis/interval-maps/interval-maps.factor b/basis/interval-maps/interval-maps.factor index 9412eaf577..a089fa3972 100644 --- a/basis/interval-maps/interval-maps.factor +++ b/basis/interval-maps/interval-maps.factor @@ -34,7 +34,7 @@ ALIAS: value third-unsafe ERROR: not-an-interval-map obj ; : check-interval-map ( map -- map ) - dup interval-map? [ throw-not-an-interval-map ] unless ; inline + dup interval-map? [ not-an-interval-map ] unless ; inline PRIVATE> diff --git a/basis/interval-sets/interval-sets.factor b/basis/interval-sets/interval-sets.factor index 3ef65ab55e..6668a3c910 100644 --- a/basis/interval-sets/interval-sets.factor +++ b/basis/interval-sets/interval-sets.factor @@ -14,7 +14,7 @@ TUPLE: interval-set { array uint-array read-only } ; ERROR: not-an-interval-set obj ; : check-interval-set ( map -- map ) - dup interval-set? [ throw-not-an-interval-set ] unless ; inline + dup interval-set? [ not-an-interval-set ] unless ; inline PRIVATE> diff --git a/basis/inverse/inverse.factor b/basis/inverse/inverse.factor index 6fcf7a59f1..8ba0289060 100644 --- a/basis/inverse/inverse.factor +++ b/basis/inverse/inverse.factor @@ -12,7 +12,7 @@ IN: inverse ERROR: fail ; M: fail summary drop "Matching failed" ; -: assure ( ? -- ) [ throw-fail ] unless ; inline +: assure ( ? -- ) [ fail ] unless ; inline : =/fail ( obj1 obj2 -- ) = assure ; inline @@ -35,7 +35,7 @@ M: fail summary drop "Matching failed" ; ERROR: bad-math-inverse ; : next ( revquot -- revquot* first ) - [ throw-bad-math-inverse ] + [ bad-math-inverse ] [ unclip-slice ] if-empty ; : constant-word? ( word -- ? ) @@ -44,7 +44,7 @@ ERROR: bad-math-inverse ; [ in>> empty? ] bi and ; : assure-constant ( constant -- quot ) - dup word? [ throw-bad-math-inverse ] when 1quotation ; + dup word? [ bad-math-inverse ] when 1quotation ; : swap-inverse ( math-inverse revquot -- revquot* quot ) next assure-constant rot second '[ @ swap @ ] ; @@ -169,7 +169,7 @@ ERROR: missing-literal ; \ ? 2 [ [ assert-literal ] bi@ - [ swap [ over = ] dip swap [ 2drop f ] [ = [ t ] [ throw-fail ] if ] if ] + [ swap [ over = ] dip swap [ 2drop f ] [ = [ t ] [ fail ] if ] if ] 2curry ] define-pop-inverse @@ -255,7 +255,7 @@ DEFER: __ : empty-inverse ( class -- quot ) deconstruct-pred - [ tuple-slots [ ] any? [ throw-fail ] when ] + [ tuple-slots [ ] any? [ fail ] when ] compose ; \ new 1 [ ?wrapped empty-inverse ] define-pop-inverse diff --git a/basis/io/backend/unix/unix.factor b/basis/io/backend/unix/unix.factor index 30a349ec23..2468c53e58 100755 --- a/basis/io/backend/unix/unix.factor +++ b/basis/io/backend/unix/unix.factor @@ -75,7 +75,7 @@ M: unix wait-for-fd ( handle event -- ) { +input+ [ add-input-callback ] } { +output+ [ add-output-callback ] } } case - "I/O" suspend [ throw-io-timeout ] when + "I/O" suspend [ io-timeout ] when ] if ; : wait-for-port ( port event -- ) @@ -86,7 +86,7 @@ M: unix wait-for-fd ( handle event -- ) ERROR: not-a-buffered-port port ; : check-buffered-port ( port -- port ) - dup buffered-port? [ throw-not-a-buffered-port ] unless ; inline + dup buffered-port? [ not-a-buffered-port ] unless ; inline M: fd refill [ check-buffered-port buffer>> ] [ fd>> ] bi* diff --git a/basis/io/directories/search/search.factor b/basis/io/directories/search/search.factor index 80f9f7cd15..e0df575bf0 100644 --- a/basis/io/directories/search/search.factor +++ b/basis/io/directories/search/search.factor @@ -103,13 +103,13 @@ PRIVATE> ERROR: file-not-found path bfs? quot ; : find-file-throws ( path bfs? quot -- path ) - 3dup find-file [ 2nip nip ] [ throw-file-not-found ] if* ; inline + 3dup find-file [ 2nip nip ] [ file-not-found ] if* ; inline ERROR: sequence-expected obj ; : ensure-sequence-of-directories ( obj -- seq ) dup string? [ 1array ] when - dup sequence? [ throw-sequence-expected ] unless ; + dup sequence? [ sequence-expected ] unless ; ! Can't make this generic# on string/sequence because of combinators : find-in-directories ( directories bfs? quot -- path'/f ) diff --git a/basis/io/encodings/8-bit/8-bit.factor b/basis/io/encodings/8-bit/8-bit.factor index 17b3a274f9..8aec5cb496 100644 --- a/basis/io/encodings/8-bit/8-bit.factor +++ b/basis/io/encodings/8-bit/8-bit.factor @@ -18,7 +18,7 @@ SYMBOL: 8-bit-encodings TUPLE: 8-bit { biassoc biassoc read-only } ; : 8-bit-encode ( char 8-bit -- byte ) - biassoc>> value-at [ throw-encode-error ] unless* ; inline + biassoc>> value-at [ encode-error ] unless* ; inline M: 8-bit encode-char swap [ 8-bit-encode ] dip stream-write1 ; diff --git a/basis/io/encodings/euc/euc.factor b/basis/io/encodings/euc/euc.factor index 3938431c9c..63a2c69cff 100644 --- a/basis/io/encodings/euc/euc.factor +++ b/basis/io/encodings/euc/euc.factor @@ -19,7 +19,7 @@ M: euc encode-char ( char stream encoding -- ) h>b/b swap 2byte-array swap stream-write ] if - ] [ throw-encode-error ] if* ; + ] [ encode-error ] if* ; : euc-multibyte? ( ch -- ? ) 0x81 0xfe between? ; diff --git a/basis/io/encodings/gb18030/gb18030.factor b/basis/io/encodings/gb18030/gb18030.factor index 57708b73cd..7e9d167857 100644 --- a/basis/io/encodings/gb18030/gb18030.factor +++ b/basis/io/encodings/gb18030/gb18030.factor @@ -90,7 +90,7 @@ ascii xml>gb-data : lookup-range ( char -- byte-array ) dup u>gb get-global interval-at [ [ ufirst>> - ] [ bfirst>> ] bi + unlinear - ] [ throw-encode-error ] if* ; + ] [ encode-error ] if* ; M: gb18030 encode-char ( char stream encoding -- ) drop [ diff --git a/basis/io/encodings/iso2022/iso2022.factor b/basis/io/encodings/iso2022/iso2022.factor index d9b9a7f6cd..9b2f3f44c5 100644 --- a/basis/io/encodings/iso2022/iso2022.factor +++ b/basis/io/encodings/iso2022/iso2022.factor @@ -44,7 +44,7 @@ CONSTANT: switch-jis212 B{ $ ESC CHAR: $ CHAR: ( CHAR: D } { [ dup jis201 get-global value? ] [ drop switch-jis201 jis201 get-global ] } { [ dup jis208 get-global value? ] [ drop switch-jis208 jis208 get-global ] } { [ dup jis212 get-global value? ] [ drop switch-jis212 jis212 get-global ] } - [ throw-encode-error ] + [ encode-error ] } cond ; : stream-write-num ( num stream -- ) diff --git a/basis/io/encodings/shift-jis/shift-jis.factor b/basis/io/encodings/shift-jis/shift-jis.factor index 7b2001255e..cd848cd6f8 100644 --- a/basis/io/encodings/shift-jis/shift-jis.factor +++ b/basis/io/encodings/shift-jis/shift-jis.factor @@ -29,7 +29,7 @@ M: windows-31j drop windows-31j-table get-global ; TUPLE: jis assoc ; -: ch>jis ( ch tuple -- jis ) assoc>> value-at [ throw-encode-error ] unless* ; +: ch>jis ( ch tuple -- jis ) assoc>> value-at [ encode-error ] unless* ; : jis>ch ( jis tuple -- string ) assoc>> at replacement-char or ; : make-jis ( filename -- jis ) diff --git a/basis/io/encodings/strict/strict.factor b/basis/io/encodings/strict/strict.factor index a82fdbedde..bf1d5376eb 100644 --- a/basis/io/encodings/strict/strict.factor +++ b/basis/io/encodings/strict/strict.factor @@ -8,4 +8,4 @@ TUPLE: strict-state code ; C: strict strict-state M: strict-state decode-char - code>> decode-char dup replacement-char = [ throw-decode-error ] when ; + code>> decode-char dup replacement-char = [ decode-error ] when ; diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 0f1266c1a9..fc651c366b 100755 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -147,7 +147,7 @@ ERROR: not-absolute-path ; [ length 2 >= ] [ second CHAR: : = ] [ first Letter? ] - } 1&& [ 2 head "\\" append ] [ throw-not-absolute-path ] if ; + } 1&& [ 2 head "\\" append ] [ not-absolute-path ] if ; > ; diff --git a/basis/io/launcher/launcher.factor b/basis/io/launcher/launcher.factor index 61f4dfe149..c93309177d 100755 --- a/basis/io/launcher/launcher.factor +++ b/basis/io/launcher/launcher.factor @@ -116,7 +116,7 @@ M: process-already-started error. process>> . ; M: process >process - dup process-started? [ throw-process-already-started ] when + dup process-started? [ process-already-started ] when clone ; M: object >process swap >>command ; @@ -135,7 +135,7 @@ M: process-was-killed error. : (wait-for-process) ( process -- status ) dup handle>> [ self over processes get at push "process" suspend drop ] when - dup killed>> [ throw-process-was-killed ] [ status>> ] if ; + dup killed>> [ process-was-killed ] [ status>> ] if ; : wait-for-process ( process -- status ) [ (wait-for-process) ] with-timeout ; @@ -158,7 +158,7 @@ M: process-failed error. ] [ process>> . ] bi ; : check-success ( process status -- ) - 0 = [ drop ] [ throw-process-failed ] if ; + 0 = [ drop ] [ process-failed ] if ; : wait-for-success ( process -- ) dup wait-for-process check-success ; @@ -290,7 +290,7 @@ M: output-process-error error. [ +closed+ or ] change-stdin utf8 (process-reader) [ [ stream-contents ] [ dup (wait-for-process) ] bi* ] with-timeout - 0 = [ 2drop ] [ throw-output-process-error ] if ; + 0 = [ 2drop ] [ output-process-error ] if ; > ] with-destructors - ] [ throw-launch-error ] recover ; + ] [ launch-error ] recover ; diff --git a/basis/io/mmap/mmap.factor b/basis/io/mmap/mmap.factor index 352d0558f4..67c245d956 100644 --- a/basis/io/mmap/mmap.factor +++ b/basis/io/mmap/mmap.factor @@ -16,7 +16,7 @@ HOOK: (mapped-file-r/w) os ( path length -- address handle ) : prepare-mapped-file ( path quot -- mapped-file path' length ) [ [ normalize-path ] [ file-info size>> ] bi - [ dup 0 <= [ throw-bad-mmap-size ] [ 2drop ] if ] + [ dup 0 <= [ bad-mmap-size ] [ 2drop ] if ] [ nip mapped-file new-disposable swap >>length ] ] dip 2tri [ >>address ] [ >>handle ] bi* ; inline diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 0ff1a1465a..208e023e08 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -45,7 +45,7 @@ M: input-port stream-read1 ERROR: not-a-c-ptr object ; : check-c-ptr ( c-ptr -- c-ptr ) - dup c-ptr? [ throw-not-a-c-ptr ] unless ; inline + dup c-ptr? [ not-a-c-ptr ] unless ; inline string ( x509name -- string ) NID_commonName 256 @@ -315,8 +315,8 @@ M: ssl-handle dispose* SSL_get_peer_certificate [ [ alternative-dns-names ] [ subject-name ] bi suffix 2dup [ subject-names-match? ] with any? - [ 2drop ] [ throw-subject-name-verify-error ] if - ] [ throw-certificate-missing-error ] if* ; + [ 2drop ] [ subject-name-verify-error ] if + ] [ certificate-missing-error ] if* ; M: openssl check-certificate ( host ssl -- ) current-secure-context config>> verify>> [ @@ -327,20 +327,20 @@ M: openssl check-certificate ( host ssl -- ) ] [ 2drop ] if ; : check-buffer ( port -- port ) - dup buffer>> buffer-empty? [ throw-upgrade-buffers-full ] unless ; + dup buffer>> buffer-empty? [ upgrade-buffers-full ] unless ; : input/output-ports ( -- input output ) input-stream output-stream [ get underlying-port check-buffer ] bi@ - 2dup [ handle>> ] bi@ eq? [ throw-upgrade-on-non-socket ] unless ; + 2dup [ handle>> ] bi@ eq? [ upgrade-on-non-socket ] unless ; : make-input/output-secure ( input output -- ) - dup handle>> non-ssl-socket? [ throw-upgrade-on-non-socket ] unless + dup handle>> non-ssl-socket? [ upgrade-on-non-socket ] unless [ ] change-handle handle>> >>handle drop ; : (send-secure-handshake) ( output -- ) - remote-address get [ throw-upgrade-on-non-socket ] unless* + remote-address get [ upgrade-on-non-socket ] unless* secure-connection ; M: openssl send-secure-handshake diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor index 43220f4f0f..ff01ecf037 100644 --- a/basis/io/sockets/sockets.factor +++ b/basis/io/sockets/sockets.factor @@ -78,12 +78,12 @@ ERROR: bad-ipv4-component string ; : parse-ipv4 ( string -- seq ) [ f ] [ - "." split dup length 4 = [ throw-malformed-ipv4 ] unless - [ dup string>number [ ] [ throw-bad-ipv4-component ] ?if ] B{ } map-as + "." split dup length 4 = [ malformed-ipv4 ] unless + [ dup string>number [ ] [ bad-ipv4-component ] ?if ] B{ } map-as ] if-empty ; : check-ipv4 ( string -- ) - [ parse-ipv4 drop ] [ throw-invalid-ipv4 ] recover ; + [ parse-ipv4 drop ] [ invalid-ipv4 ] recover ; PRIVATE> @@ -93,7 +93,7 @@ M: ipv4 inet-ntop ( data addrspec -- str ) drop 4 memory>byte-array [ number>string ] { } map-as "." join ; M: ipv4 inet-pton ( str addrspec -- data ) - drop [ parse-ipv4 ] [ throw-invalid-ipv4 ] recover ; + drop [ parse-ipv4 ] [ invalid-ipv4 ] recover ; M: ipv4 address-size drop 4 ; @@ -146,7 +146,7 @@ ERROR: bad-ipv4-embedded-prefix obj ; ERROR: more-than-8-components ; : parse-ipv6-component ( seq -- seq' ) - [ dup hex> [ nip ] [ throw-bad-ipv6-component ] if* ] { } map-as ; + [ dup hex> [ nip ] [ bad-ipv6-component ] if* ] { } map-as ; : parse-ipv6 ( string -- seq ) [ f ] [ @@ -159,7 +159,7 @@ ERROR: more-than-8-components ; ] if-empty ; : check-ipv6 ( string -- ) - [ "::" split1 [ parse-ipv6 ] bi@ 2drop ] [ throw-invalid-ipv6 ] recover ; + [ "::" split1 [ parse-ipv6 ] bi@ 2drop ] [ invalid-ipv6 ] recover ; PRIVATE> @@ -172,7 +172,7 @@ M: ipv6 inet-ntop ( data addrspec -- str ) : pad-ipv6 ( string1 string2 -- seq ) 2dup [ length ] bi@ + 8 swap - - dup 0 < [ throw-more-than-8-components ] when + dup 0 < [ more-than-8-components ] when glue ; : ipv6-bytes ( seq -- bytes ) @@ -183,7 +183,7 @@ PRIVATE> M: ipv6 inet-pton ( str addrspec -- data ) drop [ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ] - [ throw-invalid-ipv6 ] + [ invalid-ipv6 ] recover ; M: ipv6 address-size drop 16 ; @@ -293,7 +293,7 @@ ERROR: invalid-port object ; pick class-of byte-array assert= ; : check-connectionless-port ( port -- port ) - dup { [ datagram-port? ] [ raw-port? ] } 1|| [ throw-invalid-port ] unless ; + dup { [ datagram-port? ] [ raw-port? ] } 1|| [ invalid-port ] unless ; : check-send ( packet addrspec port -- packet addrspec port ) check-connectionless-port check-disposed check-port ; @@ -411,7 +411,7 @@ C: inet M: string resolve-host f prepare-addrinfo f void* [ getaddrinfo [ - dup addrinfo-error-string throw-addrinfo-error + dup addrinfo-error-string addrinfo-error ] unless-zero ] keep void* deref addrinfo memory>struct [ parse-addrinfo-list ] keep freeaddrinfo ; @@ -452,7 +452,7 @@ M: invalid-inet-server summary drop "Cannot use with ; use or instead" ; M: inet (server) - throw-invalid-inet-server ; + invalid-inet-server ; ERROR: invalid-local-address addrspec ; @@ -463,7 +463,7 @@ M: invalid-local-address summary [ [ ] [ inet4? ] [ inet6? ] tri or [ bind-local-address ] - [ throw-invalid-local-address ] if + [ invalid-local-address ] if ] dip with-variable ; inline : protocol-port ( protocol -- port ) diff --git a/basis/io/streams/duplex/duplex.factor b/basis/io/streams/duplex/duplex.factor index 118f01e5cc..ddc5974bde 100644 --- a/basis/io/streams/duplex/duplex.factor +++ b/basis/io/streams/duplex/duplex.factor @@ -46,4 +46,4 @@ ERROR: invalid-duplex-stream ; M: duplex-stream underlying-handle >duplex-stream< [ underlying-handle ] bi@ - [ = [ throw-invalid-duplex-stream ] when ] keep ; + [ = [ invalid-duplex-stream ] when ] keep ; diff --git a/basis/io/streams/limited/limited.factor b/basis/io/streams/limited/limited.factor index 087281667a..1455c8fa8c 100644 --- a/basis/io/streams/limited/limited.factor +++ b/basis/io/streams/limited/limited.factor @@ -62,11 +62,11 @@ ERROR: limit-exceeded n stream ; : check-count-bounds ( n stream -- n stream ) dup [ count>> ] [ limit>> ] bi > - [ throw-limit-exceeded ] when ; + [ limit-exceeded ] when ; : check-current-bounds ( n stream -- n stream ) dup [ current>> ] [ start>> ] bi < - [ throw-limit-exceeded ] when ; + [ limit-exceeded ] when ; : adjust-limited-read ( n stream -- n stream ) dup start>> [ diff --git a/basis/io/streams/throwing/throwing.factor b/basis/io/streams/throwing/throwing.factor index a7c340e1f1..1d53d14d3a 100644 --- a/basis/io/streams/throwing/throwing.factor +++ b/basis/io/streams/throwing/throwing.factor @@ -17,15 +17,15 @@ M: throws-on-eof-stream dispose stream>> dispose ; M:: throws-on-eof-stream stream-read1 ( stream -- obj ) stream stream>> stream-read1 - [ 1 stream \ read1 throw-stream-exhausted ] unless* ; + [ 1 stream \ read1 stream-exhausted ] unless* ; M:: throws-on-eof-stream stream-read-unsafe ( n buf stream -- count ) n buf stream stream>> stream-read-unsafe - dup n = [ n stream \ stream-read-unsafe throw-stream-exhausted ] unless ; + dup n = [ n stream \ stream-read-unsafe stream-exhausted ] unless ; M:: throws-on-eof-stream stream-read-partial-unsafe ( n buf stream -- count ) n buf stream stream>> stream-read-partial-unsafe - [ n stream \ stream-read-partial-unsafe throw-stream-exhausted ] when-zero ; + [ n stream \ stream-read-partial-unsafe stream-exhausted ] when-zero ; M: throws-on-eof-stream stream-tell stream>> stream-tell ; @@ -41,7 +41,7 @@ M: throws-on-eof-stream stream-length M: throws-on-eof-stream stream-read-until [ stream>> stream-read-until ] - [ '[ length _ \ read-until throw-stream-exhausted ] unless* ] bi ; + [ '[ length _ \ read-until stream-exhausted ] unless* ] bi ; : stream-throw-on-eof ( ..a stream quot: ( ..a stream' -- ..b ) -- ..b ) [ ] dip with-input-stream* ; inline diff --git a/basis/json/reader/reader.factor b/basis/json/reader/reader.factor index 4fc83930ba..742d8773f5 100644 --- a/basis/json/reader/reader.factor +++ b/basis/json/reader/reader.factor @@ -22,7 +22,7 @@ ERROR: not-a-json-number string ; ] dip ; : json-expect ( token stream -- ) - [ dup length ] [ stream-read ] bi* = [ throw-json-error ] unless ; inline + [ dup length ] [ stream-read ] bi* = [ json-error ] unless ; inline DEFER: (read-json-string) @@ -54,7 +54,7 @@ DEFER: (read-json-string) { CHAR: t [ CHAR: \t ] } { CHAR: u [ over read-json-escape-unicode ] } [ ] - } case [ suffix! (read-json-string) ] [ throw-json-error ] if* ; + } case [ suffix! (read-json-string) ] [ json-error ] if* ; : (read-json-string) ( stream accum -- accum ) { sbuf } declare @@ -72,7 +72,7 @@ DEFER: (read-json-string) [ length 1 - ] keep [ nth-unsafe ] [ shorten ] 2bi ; inline : check-length ( seq n -- seq ) - [ dup length ] [ >= ] bi* [ throw-json-error ] unless ; inline + [ dup length ] [ >= ] bi* [ json-error ] unless ; inline : v-over-push ( accum -- accum ) { vector } declare 2 check-length diff --git a/basis/libc/libc.factor b/basis/libc/libc.factor index 3d1bf3494e..5490070397 100644 --- a/basis/libc/libc.factor +++ b/basis/libc/libc.factor @@ -45,7 +45,7 @@ M: object strerror strerror_unsafe ; ERROR: libc-error errno message ; -: (throw-errno) ( errno -- * ) dup strerror throw-libc-error ; +: (throw-errno) ( errno -- * ) dup strerror libc-error ; : throw-errno ( -- * ) errno (throw-errno) ; @@ -72,7 +72,7 @@ M: bad-ptr summary drop "Memory allocation failed" ; : check-ptr ( c-ptr -- c-ptr ) - [ throw-bad-ptr ] unless* ; + [ bad-ptr ] unless* ; ERROR: realloc-error ptr size ; @@ -100,7 +100,7 @@ PRIVATE> : realloc ( alien size -- newalien ) [ >c-ptr ] dip - over malloc-exists? [ throw-realloc-error ] unless + over malloc-exists? [ realloc-error ] unless [ drop ] [ (realloc) check-ptr ] 2bi [ delete-malloc ] [ add-malloc ] bi* ; diff --git a/basis/locals/locals.factor b/basis/locals/locals.factor index 1545fc66a0..a95de5ffea 100644 --- a/basis/locals/locals.factor +++ b/basis/locals/locals.factor @@ -6,7 +6,7 @@ locals.errors ; IN: locals SYNTAX: :> - in-lambda? get [ throw-:>-outside-lambda-error ] unless + in-lambda? get [ :>-outside-lambda-error ] unless scan-token parse-def suffix! ; SYNTAX: [| parse-lambda append! ; diff --git a/basis/locals/parser/parser.factor b/basis/locals/parser/parser.factor index dfb1d43aef..3036bcb7cb 100644 --- a/basis/locals/parser/parser.factor +++ b/basis/locals/parser/parser.factor @@ -14,7 +14,7 @@ SYMBOL: in-lambda? ERROR: invalid-local-name name ; : check-local-name ( name -- name ) - dup { "]" "]!" } member? [ throw-invalid-local-name ] when ; + dup { "]" "]!" } member? [ invalid-local-name ] when ; : make-local ( name -- word ) check-local-name "!" ?tail [ @@ -79,7 +79,7 @@ M: lambda-parser parse-quotation ( -- quotation ) : (parse-locals-definition) ( effect vars assoc reader-quot -- word quot effect ) with-lambda-scope [ nip "lambda" set-word-prop ] - [ nip rewrite-closures dup length 1 = [ first ] [ throw-bad-rewrite ] if ] + [ nip rewrite-closures dup length 1 = [ first ] [ bad-rewrite ] if ] [ drop nip ] 3tri ; inline : parse-locals-definition ( word reader-quot -- word quot effect ) diff --git a/basis/locals/rewrite/point-free/point-free.factor b/basis/locals/rewrite/point-free/point-free.factor index b823cd2735..283a3bbd5a 100644 --- a/basis/locals/rewrite/point-free/point-free.factor +++ b/basis/locals/rewrite/point-free/point-free.factor @@ -10,7 +10,7 @@ IN: locals.rewrite.point-free : local-index ( args obj -- n ) 2dup '[ unquote _ eq? ] find drop - [ 2nip ] [ throw-bad-local ] if* ; + [ 2nip ] [ bad-local ] if* ; : read-local-quot ( args obj -- quot ) local-index neg [ get-local ] curry ; diff --git a/basis/locals/rewrite/sugar/sugar.factor b/basis/locals/rewrite/sugar/sugar.factor index 11dc896d83..6689f959e7 100644 --- a/basis/locals/rewrite/sugar/sugar.factor +++ b/basis/locals/rewrite/sugar/sugar.factor @@ -73,14 +73,14 @@ M: quotation rewrite-element rewrite-sugar* ; M: lambda rewrite-element rewrite-sugar* ; -M: let rewrite-element throw-let-form-in-literal-error ; +M: let rewrite-element let-form-in-literal-error ; M: local rewrite-element , ; M: local-reader rewrite-element , ; M: local-writer rewrite-element - throw-local-writer-in-literal-error ; + local-writer-in-literal-error ; M: word rewrite-element , ; diff --git a/basis/logging/logging.factor b/basis/logging/logging.factor index fe0a8b9255..7b2d8205ca 100644 --- a/basis/logging/logging.factor +++ b/basis/logging/logging.factor @@ -26,7 +26,7 @@ log-level [ DEBUG ] initialize ERROR: undefined-log-level ; : log-level<=> ( log-level log-level -- <=> ) - [ log-levels at* [ throw-undefined-log-level ] unless ] compare ; + [ log-levels at* [ undefined-log-level ] unless ] compare ; : log? ( log-level -- ? ) log-level get log-level<=> +lt+ = not ; @@ -40,7 +40,7 @@ ERROR: bad-log-message-parameters msg word level ; : check-log-message ( msg word level -- msg word level ) 3dup [ string? ] [ word? ] [ word? ] tri* and and - [ throw-bad-log-message-parameters ] unless ; inline + [ bad-log-message-parameters ] unless ; inline : log-message ( msg word level -- ) check-log-message diff --git a/basis/macros/macros.factor b/basis/macros/macros.factor index 8c5425c410..362e02c6e7 100644 --- a/basis/macros/macros.factor +++ b/basis/macros/macros.factor @@ -31,7 +31,7 @@ SYNTAX: MACRO: (:) define-macro ; PREDICATE: macro < word "macro" word-prop >boolean ; -M: macro make-inline throw-cannot-be-inline ; +M: macro make-inline cannot-be-inline ; M: macro definer drop \ MACRO: \ ; ; diff --git a/basis/match/match.factor b/basis/match/match.factor index b5735b834f..489fa83a38 100644 --- a/basis/match/match.factor +++ b/basis/match/match.factor @@ -51,7 +51,7 @@ M: no-match-cond summary drop "Fall-through in match-cond" ; MACRO: match-cond ( assoc -- quot ) - dup ?first callable? [ unclip ] [ [ throw-no-match-cond ] ] if + dup ?first callable? [ unclip ] [ [ no-match-cond ] ] if [ first2 [ [ dupd match ] curry ] dip diff --git a/basis/math/bitwise/bitwise.factor b/basis/math/bitwise/bitwise.factor index 8fd652b8d9..658d3586e0 100644 --- a/basis/math/bitwise/bitwise.factor +++ b/basis/math/bitwise/bitwise.factor @@ -29,7 +29,7 @@ IN: math.bitwise ERROR: bit-range-error x high low ; : bit-range ( x high low -- y ) - 2dup { [ nip 0 < ] [ < ] } 2|| [ throw-bit-range-error ] when + 2dup { [ nip 0 < ] [ < ] } 2|| [ bit-range-error ] when [ nip neg shift ] [ - 1 + ] 2bi bits ; inline : bitroll ( x s w -- y ) diff --git a/basis/math/complex/complex.factor b/basis/math/complex/complex.factor index 0de7db33a0..f57523dd02 100644 --- a/basis/math/complex/complex.factor +++ b/basis/math/complex/complex.factor @@ -38,7 +38,7 @@ IN: syntax ERROR: malformed-complex obj ; : parse-complex ( seq -- complex ) - dup length 2 = [ first2-unsafe rect> ] [ throw-malformed-complex ] if ; + dup length 2 = [ first2-unsafe rect> ] [ malformed-complex ] if ; SYNTAX: C{ \ } [ parse-complex ] parse-literal ; diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index b0fd43deb3..22e07db984 100644 --- a/basis/math/functions/functions.factor +++ b/basis/math/functions/functions.factor @@ -116,7 +116,7 @@ ERROR: non-trivial-divisor n ; : mod-inv ( x n -- y ) [ nip ] [ gcd 1 = ] 2bi [ dup 0 < [ + ] [ nip ] if ] - [ throw-non-trivial-divisor ] if ; foldable + [ non-trivial-divisor ] if ; foldable : ^mod ( x y n -- z ) over 0 < diff --git a/basis/math/matrices/matrices.factor b/basis/math/matrices/matrices.factor index a41d803410..d1894108c0 100644 --- a/basis/math/matrices/matrices.factor +++ b/basis/math/matrices/matrices.factor @@ -174,7 +174,7 @@ ERROR: negative-power-matrix m n ; [ [ dupd m. ] when [ dup m. ] dip ] reduce nip ; : m^n ( m n -- n ) - dup 0 >= [ (m^n) ] [ throw-negative-power-matrix ] if ; + dup 0 >= [ (m^n) ] [ negative-power-matrix ] if ; : stitch ( m -- m' ) [ ] [ [ append ] 2map ] map-reduce ; diff --git a/basis/math/partial-dispatch/partial-dispatch.factor b/basis/math/partial-dispatch/partial-dispatch.factor index 339ef5fb50..0789086044 100644 --- a/basis/math/partial-dispatch/partial-dispatch.factor +++ b/basis/math/partial-dispatch/partial-dispatch.factor @@ -19,7 +19,7 @@ ERROR: bad-integer-op word ; M: word integer-op-input-classes dup "input-classes" word-prop - [ ] [ throw-bad-integer-op ] ?if ; + [ ] [ bad-integer-op ] ?if ; : generic-variant ( op -- generic-op/f ) dup "derived-from" word-prop [ first ] [ ] ?if ; diff --git a/basis/math/polynomials/polynomials.factor b/basis/math/polynomials/polynomials.factor index 2c4bb9ed8f..b2ce6945f2 100644 --- a/basis/math/polynomials/polynomials.factor +++ b/basis/math/polynomials/polynomials.factor @@ -46,7 +46,7 @@ ERROR: negative-power-polynomial p n ; make-bits { 1 } [ [ over p* ] when [ p-sq ] dip ] reduce nip ; : p^ ( p n -- p^n ) - dup 0 >= [ (p^) ] [ throw-negative-power-polynomial ] if ; + dup 0 >= [ (p^) ] [ negative-power-polynomial ] if ; ] } 1&& - [ throw-invalid-lucas-lehmer-candidate ] unless ; + [ invalid-lucas-lehmer-candidate ] unless ; PRIVATE> diff --git a/basis/math/primes/primes.factor b/basis/math/primes/primes.factor index 1e9e0691c3..8ed1675ca7 100644 --- a/basis/math/primes/primes.factor +++ b/basis/math/primes/primes.factor @@ -88,7 +88,7 @@ PRIVATE> ERROR: no-relative-prime n ; : find-relative-prime* ( n guess -- p ) - [ dup 1 <= [ throw-no-relative-prime ] when ] + [ dup 1 <= [ no-relative-prime ] when ] [ >odd dup 1 <= [ drop 3 ] when ] bi* [ 2dup coprime? ] [ 2 + ] until nip ; @@ -98,6 +98,6 @@ ERROR: no-relative-prime n ; ERROR: too-few-primes n numbits ; : unique-primes ( n numbits -- seq ) - 2dup 2^ estimated-primes > [ throw-too-few-primes ] when + 2dup 2^ estimated-primes > [ too-few-primes ] when 2dup [ random-prime ] curry replicate dup all-unique? [ 2nip ] [ drop unique-primes ] if ; diff --git a/basis/math/vectors/conversion/conversion-tests.factor b/basis/math/vectors/conversion/conversion-tests.factor index 42109be718..85416f294e 100644 --- a/basis/math/vectors/conversion/conversion-tests.factor +++ b/basis/math/vectors/conversion/conversion-tests.factor @@ -21,7 +21,7 @@ MACRO:: test-vconvert ( from-type to-type -- quot ) inputs narray [ quot with-datastack ] [ [ [ declaration declare quot call ] compile-call ] with-datastack ] bi - 2dup = [ throw-optimized-vconvert-inconsistent ] unless + 2dup = [ optimized-vconvert-inconsistent ] unless drop outputs firstn ] ; diff --git a/basis/math/vectors/conversion/conversion.factor b/basis/math/vectors/conversion/conversion.factor index 47a9acd702..3c88471076 100644 --- a/basis/math/vectors/conversion/conversion.factor +++ b/basis/math/vectors/conversion/conversion.factor @@ -18,7 +18,7 @@ ERROR: bad-vconvert-input value expected-type ; { uchar ushort uint ulonglong } member-eq? ; : check-vconvert-type ( value expected-type -- value ) - 2dup instance? [ drop ] [ throw-bad-vconvert-input ] if ; inline + 2dup instance? [ drop ] [ bad-vconvert-input ] if ; inline :: [vconvert] ( from-element to-element from-size to-size from-type to-type -- quot ) { @@ -46,7 +46,7 @@ ERROR: bad-vconvert-input value expected-type ; [ steps 1 = not ] [ from-element to-element [ float-type? ] bi@ xor ] [ from-element unsigned-type? to-element unsigned-type? not and ] - } 0|| [ from-type to-type throw-bad-vconvert ] when ; + } 0|| [ from-type to-type bad-vconvert ] when ; :: ([vpack-unsigned]) ( from-type to-type -- quot ) from-type new simd-rep @@ -75,7 +75,7 @@ ERROR: bad-vconvert-input value expected-type ; [ steps 1 = not ] [ from-element to-element [ float-type? ] bi@ xor ] [ from-element unsigned-type? not to-element unsigned-type? and ] - } 0|| [ from-type to-type throw-bad-vconvert ] when ; + } 0|| [ from-type to-type bad-vconvert ] when ; :: ([vunpack]) ( from-type to-type -- quot ) from-type new simd-rep @@ -98,7 +98,7 @@ MACRO:: vconvert ( from-type to-type -- quot ) from-element heap-size :> from-size to-element heap-size :> to-size - from-length to-length = [ from-type to-type throw-bad-vconvert ] unless + from-length to-length = [ from-type to-type bad-vconvert ] unless from-element to-element from-size to-size from-type to-type { { [ from-size to-size < ] [ [vunpack] ] } diff --git a/basis/math/vectors/simd/simd.factor b/basis/math/vectors/simd/simd.factor index 90ccfcaf09..5434a4c24f 100644 --- a/basis/math/vectors/simd/simd.factor +++ b/basis/math/vectors/simd/simd.factor @@ -138,7 +138,7 @@ M: simd-128 byte-length drop 16 ; inline M: simd-128 new-sequence 2dup length = [ nip [ 16 (byte-array) ] make-underlying ] - [ length throw-bad-simd-length ] if ; inline + [ length bad-simd-length ] if ; inline M: simd-128 equal? dup simd-rep [ drop v= vall? ] [ 3drop f ] if-both-vectors-match ; inline @@ -321,7 +321,7 @@ c: A >>boxed-class { A-rep alien-vector A boa } >quotation >>getter { - [ dup simd-128? [ throw-bad-simd-vector ] unless underlying>> ] 2dip + [ dup simd-128? [ bad-simd-vector ] unless underlying>> ] 2dip A-rep set-alien-vector } >quotation >>setter 16 >>size diff --git a/basis/mime/multipart/multipart.factor b/basis/mime/multipart/multipart.factor index 20082a35c0..197b1c0718 100644 --- a/basis/mime/multipart/multipart.factor +++ b/basis/mime/multipart/multipart.factor @@ -116,7 +116,7 @@ ERROR: unknown-content-disposition multipart ; [ dup mime-separator>> dump-string >>name-content ] dip >>name dup save-mime-part ] [ - throw-unknown-content-disposition + unknown-content-disposition ] if* ] if* ; @@ -128,7 +128,7 @@ ERROR: no-content-disposition multipart ; parse-content-disposition-form-data >>content-disposition parse-form-data ] } - [ throw-no-content-disposition ] + [ no-content-disposition ] } case ; : read-assert-sequence= ( sequence -- ) diff --git a/basis/mirrors/mirrors.factor b/basis/mirrors/mirrors.factor index 9562f0b406..00c6232e76 100644 --- a/basis/mirrors/mirrors.factor +++ b/basis/mirrors/mirrors.factor @@ -21,8 +21,8 @@ ERROR: read-only-slot slot ; : check-set-slot ( val slot -- val offset ) { - { [ dup not ] [ throw-no-such-slot ] } - { [ dup read-only>> ] [ throw-read-only-slot ] } + { [ dup not ] [ no-such-slot ] } + { [ dup read-only>> ] [ read-only-slot ] } { [ 2dup class>> instance? not ] [ class>> bad-slot-value ] } [ offset>> ] } cond ; inline diff --git a/basis/multiline/multiline.factor b/basis/multiline/multiline.factor index a374290ad7..1c2c1d462d 100644 --- a/basis/multiline/multiline.factor +++ b/basis/multiline/multiline.factor @@ -28,7 +28,7 @@ ERROR: text-found-before-eol string ; : parse-here ( -- str ) [ lexer get - dup rest-of-line [ throw-text-found-before-eol ] unless-empty + dup rest-of-line [ text-found-before-eol ] unless-empty (parse-here) ] "" make but-last ; @@ -71,7 +71,7 @@ SYNTAX: STRING: begin-text lexer (parse-til-line-begins) ] if ] [ - begin-text throw-bad-heredoc + begin-text bad-heredoc ] if ; : parse-til-line-begins ( begin-text lexer -- seq ) diff --git a/basis/nibble-arrays/nibble-arrays.factor b/basis/nibble-arrays/nibble-arrays.factor index 0a9e4cd7b0..d519d4f5bc 100644 --- a/basis/nibble-arrays/nibble-arrays.factor +++ b/basis/nibble-arrays/nibble-arrays.factor @@ -33,7 +33,7 @@ PRIVATE> ERROR: bad-array-length n ; : ( n -- nibble-array ) - dup 0 < [ throw-bad-array-length ] when + dup 0 < [ bad-array-length ] when dup nibbles>bytes nibble-array boa ; inline M: nibble-array length length>> ; diff --git a/basis/opengl/annotations/annotations-docs.factor b/basis/opengl/annotations/annotations-docs.factor index d6a73bf83f..98b5bcc627 100644 --- a/basis/opengl/annotations/annotations-docs.factor +++ b/basis/opengl/annotations/annotations-docs.factor @@ -27,14 +27,14 @@ HELP: log-gl-errors { $description "Annotate every OpenGL function to log using " { $link log-gl-error } " if the function results in an error. Use " { $link reset-gl-functions } " to reverse this operation." } ; HELP: reset-gl-functions -{ $description "Removes any annotations from all OpenGL functions, such as those applied by " { $link throw-gl-errors } " or " { $link log-gl-errors } "." } ; +{ $description "Removes any annotations from all OpenGL functions, such as those applied by " { $link gl-errors } " or " { $link log-gl-errors } "." } ; -{ throw-gl-errors gl-error log-gl-errors log-gl-error clear-gl-error-log reset-gl-functions } related-words +{ gl-errors gl-error log-gl-errors log-gl-error clear-gl-error-log reset-gl-functions } related-words ARTICLE: "opengl.annotations" "OpenGL error reporting" "The " { $vocab-link "opengl.annotations" } " vocabulary provides some tools for tracking down GL errors:" { $subsections - throw-gl-errors + gl-errors log-gl-errors clear-gl-error-log reset-gl-functions diff --git a/basis/opengl/gl/extensions/extensions.factor b/basis/opengl/gl/extensions/extensions.factor index 5d6ea92ff5..15d225bd04 100644 --- a/basis/opengl/gl/extensions/extensions.factor +++ b/basis/opengl/gl/extensions/extensions.factor @@ -8,7 +8,7 @@ ERROR: unknown-gl-platform ; { [ os windows? ] [ "opengl.gl.windows" ] } { [ os macosx? ] [ "opengl.gl.macosx" ] } { [ os unix? ] [ "opengl.gl.gtk" ] } - [ throw-unknown-gl-platform ] + [ unknown-gl-platform ] } cond use-vocab >> SYMBOL: +gl-function-counter+ diff --git a/basis/opengl/textures/textures.factor b/basis/opengl/textures/textures.factor index d94f7e4f02..ade19b2279 100644 --- a/basis/opengl/textures/textures.factor +++ b/basis/opengl/textures/textures.factor @@ -148,7 +148,7 @@ M: XBGR fix-internal-component-order drop RGBA ; : image-internal-format ( component-order component-type -- internal-format ) 2dup [ fix-internal-component-order ] dip 2array image-internal-formats at - [ 2nip ] [ throw-unsupported-component-order ] if* ; + [ 2nip ] [ unsupported-component-order ] if* ; : reversed-type? ( component-type -- ? ) { u-9-9-9-e5-components float-11-11-10-components } member? ; @@ -167,7 +167,7 @@ M: XBGR fix-internal-component-order drop RGBA ; { RGBA [ drop GL_RGBA_INTEGER ] } { BGRX [ drop GL_BGRA_INTEGER ] } { RGBX [ drop GL_RGBA_INTEGER ] } - [ swap throw-unsupported-component-order ] + [ swap unsupported-component-order ] } case ] [ swap { @@ -189,22 +189,22 @@ M: XBGR fix-internal-component-order drop RGBA ; { INTENSITY [ drop GL_INTENSITY ] } { DEPTH [ drop GL_DEPTH_COMPONENT ] } { DEPTH-STENCIL [ drop GL_DEPTH_STENCIL ] } - [ swap throw-unsupported-component-order ] + [ swap unsupported-component-order ] } case ] if ; GENERIC: (component-type>type) ( component-order component-type -- gl-type ) -M: object (component-type>type) throw-unsupported-component-order ; +M: object (component-type>type) unsupported-component-order ; : four-channel-alpha-first? ( component-order component-type -- ? ) over component-count 4 = [ drop alpha-channel-precedes-colors? ] - [ throw-unsupported-component-order ] if ; + [ unsupported-component-order ] if ; : not-alpha-first ( component-order component-type -- ) over alpha-channel-precedes-colors? - [ throw-unsupported-component-order ] + [ unsupported-component-order ] [ 2drop ] if ; M: ubyte-components (component-type>type) @@ -238,22 +238,22 @@ M: u-10-10-10-2-components (component-type>type) M: u-24-components (component-type>type) over DEPTH = [ 2drop GL_UNSIGNED_INT ] - [ throw-unsupported-component-order ] if ; + [ unsupported-component-order ] if ; M: u-24-8-components (component-type>type) over DEPTH-STENCIL = [ 2drop GL_UNSIGNED_INT_24_8 ] - [ throw-unsupported-component-order ] if ; + [ unsupported-component-order ] if ; M: u-9-9-9-e5-components (component-type>type) over BGR = [ 2drop GL_UNSIGNED_INT_5_9_9_9_REV ] - [ throw-unsupported-component-order ] if ; + [ unsupported-component-order ] if ; M: float-11-11-10-components (component-type>type) over BGR = [ 2drop GL_UNSIGNED_INT_10F_11F_11F_REV ] - [ throw-unsupported-component-order ] if ; + [ unsupported-component-order ] if ; : image-data-format ( component-order component-type -- gl-format gl-type ) [ (component-order>format) ] [ (component-type>type) ] 2bi ; diff --git a/basis/pack/pack.factor b/basis/pack/pack.factor index 25ab4386d8..8fe0e9f8a9 100644 --- a/basis/pack/pack.factor +++ b/basis/pack/pack.factor @@ -142,7 +142,7 @@ ERROR: packed-read-fail str bytes ; : read-packed-bytes ( str -- bytes ) dup packed-length [ read dup length ] keep = - [ nip ] [ throw-packed-read-fail ] if ; inline + [ nip ] [ packed-read-fail ] if ; inline PRIVATE> diff --git a/basis/peg/ebnf/ebnf.factor b/basis/peg/ebnf/ebnf.factor index d5ff45c206..49ad57ac1b 100644 --- a/basis/peg/ebnf/ebnf.factor +++ b/basis/peg/ebnf/ebnf.factor @@ -18,7 +18,7 @@ ERROR: no-rule rule parser ; > (transform) [ - swap symbol>> dup get parser? [ throw-redefined-rule ] [ set ] if + swap symbol>> dup get parser? [ redefined-rule ] [ set ] if ] keep ; M: ebnf-sequence (transform) ( ast -- parser ) diff --git a/basis/peg/peg.factor b/basis/peg/peg.factor index 5294f82038..f08f0359f9 100644 --- a/basis/peg/peg.factor +++ b/basis/peg/peg.factor @@ -618,7 +618,7 @@ SYNTAX: PEG: def call compile :> compiled-def [ dup compiled-def compiled-parse - [ ast>> ] [ word throw-parse-failed ] ?if + [ ast>> ] [ word parse-failed ] ?if ] word swap effect define-declared ] with-compilation-unit diff --git a/basis/persistent/vectors/vectors.factor b/basis/persistent/vectors/vectors.factor index bf2e93fa71..862eed1aa9 100644 --- a/basis/persistent/vectors/vectors.factor +++ b/basis/persistent/vectors/vectors.factor @@ -161,7 +161,7 @@ PRIVATE> M: persistent-vector ppop ( pvec -- pvec' ) dup count>> { - { 0 [ throw-empty-error ] } + { 0 [ empty-error ] } { 1 [ drop T{ persistent-vector } ] } [ [ diff --git a/basis/random/random.factor b/basis/random/random.factor index 5bbf186494..2584412bcd 100644 --- a/basis/random/random.factor +++ b/basis/random/random.factor @@ -35,9 +35,9 @@ ERROR: no-random-number-generator ; M: no-random-number-generator summary drop "Random number generator is not defined." ; -M: f random-bytes* ( n obj -- * ) throw-no-random-number-generator ; +M: f random-bytes* ( n obj -- * ) no-random-number-generator ; -M: f random-32* ( obj -- * ) throw-no-random-number-generator ; +M: f random-32* ( obj -- * ) no-random-number-generator ; : random-32 ( -- n ) random-generator get random-32* ; @@ -127,7 +127,7 @@ M: hash-set random ERROR: too-many-samples seq n ; : sample ( seq n -- seq' ) - 2dup [ length ] dip < [ throw-too-many-samples ] when + 2dup [ length ] dip < [ too-many-samples ] when [ [ length iota >array ] dip [ randomize-n-last ] keep tail-slice* ] [ drop ] 2bi nths-unsafe ; diff --git a/basis/random/windows/windows.factor b/basis/random/windows/windows.factor index 3b20527f5f..af02540ba0 100755 --- a/basis/random/windows/windows.factor +++ b/basis/random/windows/windows.factor @@ -33,7 +33,7 @@ ERROR: acquire-crypto-context-failed provider type error ; [ acquire-crypto-context ] [ drop [ create-crypto-context ] - [ throw-acquire-crypto-context-failed ] recover + [ acquire-crypto-context-failed ] recover ] recover ; : initialize-crypto-context ( crypto-context -- crypto-context ) diff --git a/basis/regexp/parser/parser.factor b/basis/regexp/parser/parser.factor index fb9336c404..01cff98901 100644 --- a/basis/regexp/parser/parser.factor +++ b/basis/regexp/parser/parser.factor @@ -13,7 +13,7 @@ IN: regexp.parser ERROR: bad-number ; : ensure-number ( n -- n ) - [ throw-bad-number ] unless* ; + [ bad-number ] unless* ; :: at-error ( key assoc quot: ( key -- replacement ) -- value ) key assoc at* [ drop key quot call ] unless ; inline @@ -45,13 +45,13 @@ MEMO: simple-category-table ( -- table ) { [ "script=" ?head ] [ dup simple-script-table at [ ] - [ "script=" prepend throw-bad-class ] ?if + [ "script=" prepend bad-class ] ?if ] } - [ throw-bad-class ] + [ bad-class ] } cond ; : unicode-class ( name -- class ) - dup parse-unicode-class [ ] [ throw-bad-class ] ?if ; + dup parse-unicode-class [ ] [ bad-class ] ?if ; : name>class ( name -- class ) >string simple { @@ -106,7 +106,7 @@ MEMO: simple-category-table ( -- table ) ERROR: nonexistent-option name ; : ch>option ( ch -- singleton ) - dup options-assoc at [ ] [ throw-nonexistent-option ] ?if ; + dup options-assoc at [ ] [ nonexistent-option ] ?if ; : option>ch ( option -- string ) options-assoc value-at ; @@ -198,7 +198,7 @@ Number = (!(","|"}").)* => [[ string>number ensure-number ]] Times = "," Number:n "}" => [[ 0 n ]] | Number:n ",}" => [[ n ]] | Number:n "}" => [[ n n ]] - | "}" => [[ throw-bad-number ]] + | "}" => [[ bad-number ]] | Number:n "," Number:m "}" => [[ n m ]] Repeated = Element:e "{" Times:t => [[ e t ]] diff --git a/basis/roman/roman.factor b/basis/roman/roman.factor index a5791d7ac7..346226bf4e 100644 --- a/basis/roman/roman.factor +++ b/basis/roman/roman.factor @@ -18,7 +18,7 @@ CONSTANT: roman-values ERROR: roman-range-error n ; : roman-range-check ( n -- n ) - dup 1 10000 between? [ throw-roman-range-error ] unless ; + dup 1 10000 between? [ roman-range-error ] unless ; : roman-digit-index ( ch -- n ) 1string roman-digits index ; inline diff --git a/basis/sequences/unrolled/unrolled.factor b/basis/sequences/unrolled/unrolled.factor index 4d83294dd0..ad28dde00d 100644 --- a/basis/sequences/unrolled/unrolled.factor +++ b/basis/sequences/unrolled/unrolled.factor @@ -34,11 +34,11 @@ ERROR: unrolled-2bounds-error [ 2over throw-unrolled-bounds-error ] when ; inline + 2over swap length > [ 2over unrolled-bounds-error ] when ; inline :: unrolled-2bounds-check ( xseq yseq len quot -- xseq yseq len quot ) { [ len xseq length > ] [ len yseq length > ] } 0|| - [ xseq yseq len throw-unrolled-2bounds-error ] + [ xseq yseq len unrolled-2bounds-error ] [ xseq yseq len quot ] if ; inline : (unrolled-each) ( seq len quot -- len quot ) diff --git a/basis/smtp/smtp.factor b/basis/smtp/smtp.factor index 47429b823d..48ea2c1814 100644 --- a/basis/smtp/smtp.factor +++ b/basis/smtp/smtp.factor @@ -69,7 +69,7 @@ ERROR: bad-email-address email ; : validate-address ( string -- string' ) #! Make sure we send funky stuff to the server by accident. dup "\r\n>" intersects? - [ throw-bad-email-address ] when ; + [ bad-email-address ] when ; : mail-from ( fromaddr -- ) validate-address @@ -130,17 +130,17 @@ ERROR: smtp-transaction-failed < smtp-error ; : check-response ( response -- ) dup code>> { { [ dup { 220 235 250 221 354 } member? ] [ 2drop ] } - { [ dup 400 499 between? ] [ drop throw-smtp-server-busy ] } - { [ dup 500 = ] [ drop throw-smtp-syntax-error ] } - { [ dup 501 = ] [ drop throw-smtp-command-not-implemented ] } - { [ dup 500 509 between? ] [ drop throw-smtp-syntax-error ] } - { [ dup 530 539 between? ] [ drop throw-smtp-bad-authentication ] } - { [ dup 550 = ] [ drop throw-smtp-mailbox-unavailable ] } - { [ dup 551 = ] [ drop throw-smtp-user-not-local ] } - { [ dup 552 = ] [ drop throw-smtp-exceeded-storage-allocation ] } - { [ dup 553 = ] [ drop throw-smtp-bad-mailbox-name ] } - { [ dup 554 = ] [ drop throw-smtp-transaction-failed ] } - [ drop throw-smtp-error ] + { [ dup 400 499 between? ] [ drop smtp-server-busy ] } + { [ dup 500 = ] [ drop smtp-syntax-error ] } + { [ dup 501 = ] [ drop smtp-command-not-implemented ] } + { [ dup 500 509 between? ] [ drop smtp-syntax-error ] } + { [ dup 530 539 between? ] [ drop smtp-bad-authentication ] } + { [ dup 550 = ] [ drop smtp-mailbox-unavailable ] } + { [ dup 551 = ] [ drop smtp-user-not-local ] } + { [ dup 552 = ] [ drop smtp-exceeded-storage-allocation ] } + { [ dup 553 = ] [ drop smtp-bad-mailbox-name ] } + { [ dup 554 = ] [ drop smtp-transaction-failed ] } + [ drop smtp-error ] } cond ; : get-ok ( -- ) receive-response check-response ; @@ -168,7 +168,7 @@ ERROR: invalid-header-string string ; : validate-header ( string -- string' ) dup "\r\n" intersects? - [ throw-invalid-header-string ] when ; + [ invalid-header-string ] when ; : write-header ( key value -- ) [ validate-header write ] diff --git a/basis/specialized-arrays/specialized-arrays.factor b/basis/specialized-arrays/specialized-arrays.factor index 5e593c4fab..7976a5c148 100644 --- a/basis/specialized-arrays/specialized-arrays.factor +++ b/basis/specialized-arrays/specialized-arrays.factor @@ -136,35 +136,35 @@ ERROR: specialized-array-vocab-not-loaded c-type ; M: c-type-word c-array-constructor underlying-type dup [ name>> "<" "-array>" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ throw-specialized-array-vocab-not-loaded ] ?if ; foldable + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: pointer c-array-constructor drop void* c-array-constructor ; M: c-type-word c-(array)-constructor underlying-type dup [ name>> "(" "-array)" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ throw-specialized-array-vocab-not-loaded ] ?if ; foldable + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: pointer c-(array)-constructor drop void* c-(array)-constructor ; M: c-type-word c-direct-array-constructor underlying-type dup [ name>> "" surround ] [ specialized-array-vocab ] bi lookup-word - [ ] [ throw-specialized-array-vocab-not-loaded ] ?if ; foldable + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: pointer c-direct-array-constructor drop void* c-direct-array-constructor ; M: c-type-word c-array-type underlying-type dup [ name>> "-array" append ] [ specialized-array-vocab ] bi lookup-word - [ ] [ throw-specialized-array-vocab-not-loaded ] ?if ; foldable + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: pointer c-array-type drop void* c-array-type ; M: c-type-word c-array-type? underlying-type dup [ name>> "-array?" append ] [ specialized-array-vocab ] bi lookup-word - [ ] [ throw-specialized-array-vocab-not-loaded ] ?if ; foldable + [ ] [ specialized-array-vocab-not-loaded ] ?if ; foldable M: pointer c-array-type? drop void* c-array-type? ; diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 8f97d38f92..5426b773b2 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -297,7 +297,7 @@ DEFER: an-inline-word ERROR: custom-error ; { T{ effect f { } { } t } } [ - [ throw-custom-error ] infer + [ custom-error ] infer ] unit-test : funny-throw ( a -- * ) throw ; inline @@ -307,7 +307,7 @@ ERROR: custom-error ; ] unit-test { T{ effect f { } { } t } } [ - [ throw-custom-error inference-error ] infer + [ custom-error inference-error ] infer ] unit-test { T{ effect f { "x" } { "x" "x" } t } } [ diff --git a/basis/tools/annotations/annotations.factor b/basis/tools/annotations/annotations.factor index 7fd3bd6b14..dd71e63ffb 100644 --- a/basis/tools/annotations/annotations.factor +++ b/basis/tools/annotations/annotations.factor @@ -33,7 +33,7 @@ PREDICATE: annotated < word "unannotated-def" word-prop >boolean ; - [ n buf stream word throw-invalid-stream-read-unsafe ] + [ n buf stream word invalid-stream-read-unsafe ] [ n buf stream ] if ] if ; inline :: check-stream-read-unsafe-after ( count n buf stream word -- count ) count n > - [ count n buf stream word throw-invalid-stream-read-unsafe-return ] + [ count n buf stream word invalid-stream-read-unsafe-return ] [ count ] if ; : (assert-stream-read-unsafe) ( word -- ) diff --git a/basis/tools/deploy/backend/backend.factor b/basis/tools/deploy/backend/backend.factor index 8d830e6ba4..1523cd5f98 100644 --- a/basis/tools/deploy/backend/backend.factor +++ b/basis/tools/deploy/backend/backend.factor @@ -25,7 +25,7 @@ ERROR: can't-deploy-library-file library ; : copy-library ( dir library -- ) dup find-library-file [ swap over file-name append-path copy-file ] - [ throw-can't-deploy-library-file ] ?if ; + [ can't-deploy-library-file ] ?if ; : copy-libraries ( manifest name dir -- ) append-path swap libraries>> [ copy-library ] with each ; diff --git a/basis/tools/deploy/deploy.factor b/basis/tools/deploy/deploy.factor index 403a9bfbd8..b647c5b5c7 100644 --- a/basis/tools/deploy/deploy.factor +++ b/basis/tools/deploy/deploy.factor @@ -7,10 +7,10 @@ IN: tools.deploy ERROR: no-vocab-main vocab ; : check-vocab-main ( vocab -- vocab ) - [ require ] keep dup vocab-main [ throw-no-vocab-main ] unless ; + [ require ] keep dup vocab-main [ no-vocab-main ] unless ; : deploy ( vocab -- ) - dup find-vocab-root [ check-vocab-main deploy* ] [ throw-no-vocab ] if ; + dup find-vocab-root [ check-vocab-main deploy* ] [ no-vocab ] if ; : deploy-image-only ( vocab image -- ) [ vm-path ] 2dip diff --git a/basis/tools/deploy/shaker/strip-specialized-arrays.factor b/basis/tools/deploy/shaker/strip-specialized-arrays.factor index 7b402ab436..195a3db976 100644 --- a/basis/tools/deploy/shaker/strip-specialized-arrays.factor +++ b/basis/tools/deploy/shaker/strip-specialized-arrays.factor @@ -2,4 +2,4 @@ IN: specialized-arrays ERROR: cannot-define-array-in-deployed-app type ; -: define-array-vocab ( type -- ) throw-cannot-define-array-in-deployed-app ; +: define-array-vocab ( type -- ) cannot-define-array-in-deployed-app ; diff --git a/basis/tools/deploy/test/test.factor b/basis/tools/deploy/test/test.factor index 367aa21fff..05e16ca10f 100644 --- a/basis/tools/deploy/test/test.factor +++ b/basis/tools/deploy/test/test.factor @@ -23,7 +23,7 @@ ERROR: image-too-big actual-size max-size ; cpu ppc? [ 100000 + ] when os windows? [ 160000 + ] when ] bi* - 2dup <= [ 2drop ] [ throw-image-too-big ] if ; + 2dup <= [ 2drop ] [ image-too-big ] if ; : deploy-test-command ( -- args ) os macosx? diff --git a/basis/tools/deploy/windows/ico/ico.factor b/basis/tools/deploy/windows/ico/ico.factor index adf2bdd600..e656597a38 100755 --- a/basis/tools/deploy/windows/ico/ico.factor +++ b/basis/tools/deploy/windows/ico/ico.factor @@ -58,10 +58,10 @@ ERROR: unsupported-ico-format bytes format ; : check-ico-type ( bytes -- bytes ) dup "PNG" head? [ - "PNG" throw-unsupported-ico-format + "PNG" unsupported-ico-format ] when dup B{ 0 0 } head? [ - "UNKNOWN" throw-unsupported-ico-format + "UNKNOWN" unsupported-ico-format ] unless ; PRIVATE> diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 01d6c325ba..185791883f 100644 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -66,7 +66,7 @@ M: object file-spec>string ( file-listing spec -- string ) { +file-date+ [ file-info>> modified>> listing-date ] } { +file-time+ [ file-info>> modified>> listing-time ] } { +file-datetime+ [ file-info>> modified>> timestamp>ymdhms ] } - [ throw-unknown-file-spec ] + [ unknown-file-spec ] } case ; : list-files-fast ( listing-tool -- array ) diff --git a/basis/tools/scaffold/scaffold.factor b/basis/tools/scaffold/scaffold.factor index 754a33c0ff..1eb40445fe 100644 --- a/basis/tools/scaffold/scaffold.factor +++ b/basis/tools/scaffold/scaffold.factor @@ -25,10 +25,10 @@ ERROR: not-a-vocab-root string ; : contains-separator? ( string -- ? ) [ path-separator? ] any? ; : ensure-vocab-exists ( string -- string ) - dup loaded-vocab-names member? [ throw-no-vocab ] unless ; + dup loaded-vocab-names member? [ no-vocab ] unless ; : check-root ( string -- string ) - dup vocab-root? [ throw-not-a-vocab-root ] unless ; + dup vocab-root? [ not-a-vocab-root ] unless ; : check-vocab-root/vocab ( vocab-root string -- vocab-root string ) [ check-root ] [ check-vocab-name ] bi* ; diff --git a/basis/tr/tr.factor b/basis/tr/tr.factor index f6349e091e..b937b25b93 100644 --- a/basis/tr/tr.factor +++ b/basis/tr/tr.factor @@ -15,7 +15,7 @@ M: bad-tr summary : tr-nth ( n mapping -- ch ) nth-unsafe 127 bitand ; inline : check-tr ( from to -- ) - [ [ ascii? ] all? ] both? [ throw-bad-tr ] unless ; + [ [ ascii? ] all? ] both? [ bad-tr ] unless ; : compute-tr ( quot from to -- mapping ) [ 128 iota ] 3dip zip diff --git a/basis/tuple-arrays/tuple-arrays.factor b/basis/tuple-arrays/tuple-arrays.factor index 6e995a813d..869f8bf5a1 100644 --- a/basis/tuple-arrays/tuple-arrays.factor +++ b/basis/tuple-arrays/tuple-arrays.factor @@ -33,8 +33,8 @@ MACRO: write-tuple ( class -- quot ) : check-final ( class -- ) { - { [ dup tuple-class? not ] [ throw-not-a-tuple ] } - { [ dup final-class? not ] [ throw-not-final ] } + { [ dup tuple-class? not ] [ not-a-tuple ] } + { [ dup final-class? not ] [ not-final ] } [ drop ] } cond ; diff --git a/basis/typed/namespaces/namespaces.factor b/basis/typed/namespaces/namespaces.factor index 5b371ea0d6..f86ad952a3 100644 --- a/basis/typed/namespaces/namespaces.factor +++ b/basis/typed/namespaces/namespaces.factor @@ -19,7 +19,7 @@ PRIVATE> :: (typed-get) ( name type getter: ( name -- value ) -- value ) name getter call :> value - value type instance? [ name value type throw-variable-type-error ] unless + value type instance? [ name value type variable-type-error ] unless value type declare1 ; inline : typed-get ( name type -- value ) @@ -29,7 +29,7 @@ PRIVATE> [ get-global ] (typed-get) ; inline :: (typed-set) ( value name type setter: ( value name -- ) -- ) - value type instance? [ name value type throw-variable-type-error ] unless + value type instance? [ name value type variable-type-error ] unless value name setter call ; inline : typed-set ( value name type -- ) diff --git a/basis/typed/typed.factor b/basis/typed/typed.factor index c835713606..4a14e5d3b7 100644 --- a/basis/typed/typed.factor +++ b/basis/typed/typed.factor @@ -69,14 +69,14 @@ PREDICATE: typed-word < word "typed-word" word-prop >boolean ; :: typed-inputs ( quot word types -- quot' ) types unboxed-types :> unboxed-types - [ throw-input-mismatch-error ] word types make-unboxer + [ input-mismatch-error ] word types make-unboxer unboxed-types quot '[ _ declare @ ] compose ; ! typed outputs :: typed-outputs ( quot word types -- quot' ) - [ throw-output-mismatch-error ] word types make-unboxer + [ output-mismatch-error ] word types make-unboxer quot prepose ; DEFER: make-boxer @@ -143,7 +143,7 @@ MACRO: typed ( quot word effect -- quot' ) dup { [ effect-in-types typed-stack-effect? ] [ effect-out-types typed-stack-effect? ] - } 1|| [ (typed-def) ] [ nip throw-no-types-specified ] if ; + } 1|| [ (typed-def) ] [ nip no-types-specified ] if ; M: typed-word subwords [ call-next-method ] diff --git a/basis/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor index b9204f5853..38fb92e1f0 100644 --- a/basis/ui/gadgets/labels/labels.factor +++ b/basis/ui/gadgets/labels/labels.factor @@ -30,7 +30,7 @@ M: label string<< ( string label -- ) { { [ dup string-array? ] [ ] } { [ dup string? ] [ ?string-lines ] } - [ throw-not-a-string ] + [ not-a-string ] } cond ] dip [ text<< ] [ relayout ] bi ; inline diff --git a/basis/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor index 961f9bc766..f4b494fa3f 100644 --- a/basis/ui/gadgets/worlds/worlds.factor +++ b/basis/ui/gadgets/worlds/worlds.factor @@ -103,7 +103,7 @@ ERROR: no-world-found ; : find-gl-context ( gadget -- ) find-world dup - [ set-gl-context ] [ throw-no-world-found ] if ; + [ set-gl-context ] [ no-world-found ] if ; : (request-focus) ( child world ? -- ) pick parent>> pick eq? [ diff --git a/basis/ui/pixel-formats/pixel-formats.factor b/basis/ui/pixel-formats/pixel-formats.factor index 1f05c667f0..caca019cbc 100644 --- a/basis/ui/pixel-formats/pixel-formats.factor +++ b/basis/ui/pixel-formats/pixel-formats.factor @@ -52,7 +52,7 @@ TUPLE: pixel-format < disposable world handle ; : ( world attributes -- pixel-format ) 2dup (make-pixel-format) [ pixel-format new-disposable swap >>handle swap >>world ] - [ throw-invalid-pixel-format-attributes ] + [ invalid-pixel-format-attributes ] ?if ; M: pixel-format dispose* diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index 9138a2f533..e51ccc40c4 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -62,7 +62,7 @@ PRIVATE> ERROR: no-group string ; : ?group-id ( string -- id ) - dup group-struct [ nip gr_gid>> ] [ throw-no-group ] if* ; + dup group-struct [ nip gr_gid>> ] [ no-group ] if* ; >vendor-id ] } { "wp" [ "yes" = >>wp? ] } { "TLB size" [ >>tlb-size ] } - [ throw-unknown-cpuinfo-line ] + [ unknown-cpuinfo-line ] } case ; diff --git a/basis/unix/unix.factor b/basis/unix/unix.factor index 76b0663479..4364fd40d0 100644 --- a/basis/unix/unix.factor +++ b/basis/unix/unix.factor @@ -32,7 +32,7 @@ MACRO:: unix-system-call ( quot -- quot ) failed [ n narray errno dup strerror - word throw-unix-system-call-error + word unix-system-call-error ] [ n ndrop ret @@ -51,7 +51,7 @@ MACRO:: unix-system-call-allow-eintr ( quot -- quot ) errno EINTR = [ n narray errno dup strerror - word throw-unix-system-call-error + word unix-system-call-error ] unless ] [ n ndrop diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index a3c4432d89..ee2e592c1f 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -71,7 +71,7 @@ M: string user-passwd ( string -- passwd/f ) ERROR: no-user string ; : ?user-id ( string -- id/f ) - dup user-passwd [ nip uid>> ] [ throw-no-user ] if* ; + dup user-passwd [ nip uid>> ] [ no-user ] if* ; : real-user-id ( -- id ) unix.ffi:getuid ; inline @@ -132,6 +132,6 @@ M: string set-effective-user ( string -- ) ERROR: no-such-user obj ; : user-home ( name/uid -- path ) - dup user-passwd [ nip dir>> ] [ throw-no-such-user ] if* ; + dup user-passwd [ nip dir>> ] [ no-such-user ] if* ; os macosx? [ "unix.users.macosx" require ] when diff --git a/basis/unrolled-lists/unrolled-lists.factor b/basis/unrolled-lists/unrolled-lists.factor index 000782743f..bfb8e07e4f 100644 --- a/basis/unrolled-lists/unrolled-lists.factor +++ b/basis/unrolled-lists/unrolled-lists.factor @@ -85,7 +85,7 @@ M: unrolled-list peek-front* drop ; inline M: unrolled-list pop-front* - dup front>> [ throw-empty-unrolled-list ] unless* + dup front>> [ empty-unrolled-list ] unless* over front-pos>> unroll-factor 1 - eq? [ pop-front/new ] [ pop-front/existing ] if ; @@ -131,7 +131,7 @@ M: unrolled-list peek-back* drop ; inline M: unrolled-list pop-back* - dup back>> [ throw-empty-unrolled-list ] unless* + dup back>> [ empty-unrolled-list ] unless* over back-pos>> 1 eq? [ pop-back/new ] [ pop-back/existing ] if ; diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index a1f26d43eb..f149f499d9 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -30,7 +30,7 @@ ERROR: malformed-port ; : parse-host ( string -- host/f port/f ) [ ":" split1-last [ url-decode ] - [ dup [ string>number [ throw-malformed-port ] unless* ] when ] bi* + [ dup [ string>number [ malformed-port ] unless* ] when ] bi* ] [ f f ] if* ; GENERIC: >url ( obj -- url ) diff --git a/basis/vlists/vlists.factor b/basis/vlists/vlists.factor index 97e9b29ccc..79870b483f 100644 --- a/basis/vlists/vlists.factor +++ b/basis/vlists/vlists.factor @@ -33,7 +33,7 @@ M: vlist ppush ERROR: empty-vlist-error ; M: vlist ppop - [ throw-empty-vlist-error ] + [ empty-vlist-error ] [ [ length>> 1 - ] [ vector>> ] bi vlist boa ] if-empty ; M: vlist clone diff --git a/basis/vocabs/hierarchy/hierarchy.factor b/basis/vocabs/hierarchy/hierarchy.factor index 7172c461cb..96b8723e68 100644 --- a/basis/vocabs/hierarchy/hierarchy.factor +++ b/basis/vocabs/hierarchy/hierarchy.factor @@ -34,7 +34,7 @@ M: vocab-prefix vocab-name name>> ; ERROR: vocab-root-required root ; : ensure-vocab-root ( root -- root ) - dup vocab-roots get member? [ throw-vocab-root-required ] unless ; + dup vocab-roots get member? [ vocab-root-required ] unless ; : ensure-vocab-root/prefix ( root prefix -- root prefix ) [ ensure-vocab-root ] [ check-vocab-name ] bi* ; diff --git a/basis/vocabs/metadata/metadata.factor b/basis/vocabs/metadata/metadata.factor index 7246afa06a..a1ab1e06e6 100644 --- a/basis/vocabs/metadata/metadata.factor +++ b/basis/vocabs/metadata/metadata.factor @@ -8,7 +8,7 @@ vocabs.loader words ; IN: vocabs.metadata : check-vocab ( vocab -- vocab ) - dup find-vocab-root [ throw-no-vocab ] unless ; + dup find-vocab-root [ no-vocab ] unless ; MEMO: vocab-file-contents ( vocab name -- seq ) vocab-append-path dup @@ -18,7 +18,7 @@ MEMO: vocab-file-contents ( vocab name -- seq ) dupd vocab-append-path [ swap [ ?delete-file ] [ swap utf8 set-file-lines ] if-empty \ vocab-file-contents reset-memoized - ] [ vocab-name throw-no-vocab ] ?if ; + ] [ vocab-name no-vocab ] ?if ; : vocab-windows-icon-path ( vocab -- string ) vocab-dir "icon.ico" append-path ; @@ -92,7 +92,7 @@ ERROR: bad-platform name ; : vocab-platforms ( vocab -- platforms ) dup vocab-platforms-path vocab-file-contents - [ dup "system" lookup-word [ ] [ throw-bad-platform ] ?if ] map ; + [ dup "system" lookup-word [ ] [ bad-platform ] ?if ] map ; : set-vocab-platforms ( platforms vocab -- ) [ [ name>> ] map ] dip @@ -119,12 +119,12 @@ ERROR: bad-platform name ; TUPLE: unsupported-platform vocab requires ; : throw-unsupported-platform ( vocab requires -- ) - \ unsupported-platform boa throw-continue ; + unsupported-platform boa throw-continue ; M: unsupported-platform summary drop "Current operating system not supported by this vocabulary" ; [ dup vocab-platforms dup supported-platform? - [ 2drop ] [ [ vocab-name ] dip throw-unsupported-platform ] if + [ 2drop ] [ [ vocab-name ] dip unsupported-platform ] if ] check-vocab-hook set-global diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index d69e02ab8d..15abd924d8 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -94,7 +94,7 @@ FUNCTION: void ReleaseStgMedium ( LPSTGMEDIUM pmedium ) ERROR: null-com-release ; : com-release ( interface -- ) - [ IUnknown::Release drop ] [ throw-null-com-release ] if* ; inline + [ IUnknown::Release drop ] [ null-com-release ] if* ; inline : with-com-interface ( interface quot -- ) over [ com-release ] curry [ ] cleanup ; inline diff --git a/basis/windows/com/syntax/syntax.factor b/basis/windows/com/syntax/syntax.factor index 85a1fbb00a..f6cf51d3d4 100755 --- a/basis/windows/com/syntax/syntax.factor +++ b/basis/windows/com/syntax/syntax.factor @@ -31,7 +31,7 @@ ERROR: no-com-interface interface ; : find-com-interface-definition ( name -- definition ) [ dup +com-interface-definitions+ get-global at* - [ nip ] [ drop throw-no-com-interface ] if + [ nip ] [ drop no-com-interface ] if ] [ f ] if* ; : save-com-interface-definition ( definition -- ) diff --git a/basis/windows/gdiplus/gdiplus.factor b/basis/windows/gdiplus/gdiplus.factor index 5398dd4706..a43ce235ba 100644 --- a/basis/windows/gdiplus/gdiplus.factor +++ b/basis/windows/gdiplus/gdiplus.factor @@ -1628,7 +1628,7 @@ FUNCTION: GpStatus GdipTestControl ( GpTestControlEnum x, void* x ) ERROR: gdi+-error status ; : check-gdi+-status ( GpStatus -- ) - dup Ok = [ drop ] [ throw-gdi+-error ] if ; + dup Ok = [ drop ] [ gdi+-error ] if ; CONSTANT: standard-gdi+-startup-input S{ GdiplusStartupInput diff --git a/basis/windows/iphlpapi/iphlpapi.factor b/basis/windows/iphlpapi/iphlpapi.factor index 422d83fbc1..e3f2da7b18 100644 --- a/basis/windows/iphlpapi/iphlpapi.factor +++ b/basis/windows/iphlpapi/iphlpapi.factor @@ -141,7 +141,7 @@ ERROR: unknown-sockaddr-length sockaddr length ; dup iSockaddrLength>> { { 16 [ lpSockaddr>> sockaddr-in memory>struct ] } { 28 [ lpSockaddr>> sockaddr-in6 memory>struct ] } - [ throw-unknown-sockaddr-length ] + [ unknown-sockaddr-length ] } case ; TYPEDEF: SOCKET_ADDRESS* PSOCKET_ADDRESS diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 65d64b85fb..968b52fbe4 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -19,7 +19,7 @@ CONSTANT: registry-value-max-length 16384 drop ] [ [ key subkey mode ] dip n>win32-error-string - throw-open-key-failed + open-key-failed ] if ] keep HKEY deref ; @@ -36,7 +36,7 @@ CONSTANT: registry-value-max-length 16384 hKey lpSubKey 0 lpClass dwOptions samDesired lpSecurityAttributes ] dip n>win32-error-string - throw-create-key-failed + create-key-failed ] unless ; : create-key ( hkey lsubkey -- hkey ) diff --git a/basis/windows/winmm/winmm.factor b/basis/windows/winmm/winmm.factor index fa87ad9001..db6a18e69b 100644 --- a/basis/windows/winmm/winmm.factor +++ b/basis/windows/winmm/winmm.factor @@ -20,7 +20,7 @@ ALIAS: mciSendString mciSendStringW ERROR: mci-error n ; : check-mci-error ( n -- ) - [ throw-mci-error ] unless-zero ; + [ mci-error ] unless-zero ; : open-command ( path -- ) "open \"%s\" type mpegvideo alias MediaFile" sprintf f 0 f diff --git a/basis/windows/winsock/winsock.factor b/basis/windows/winsock/winsock.factor index 59a2651263..6013169509 100644 --- a/basis/windows/winsock/winsock.factor +++ b/basis/windows/winsock/winsock.factor @@ -446,17 +446,17 @@ ERROR: winsock-exception n string ; : winsock-error ( -- ) maybe-winsock-exception [ throw ] when* ; -: (throw-winsock-error) ( n -- * ) - [ ] [ n>win32-error-string ] bi throw-winsock-exception ; +: (winsock-error) ( n -- * ) + [ ] [ n>win32-error-string ] bi winsock-exception ; : throw-winsock-error ( -- * ) - WSAGetLastError (throw-winsock-error) ; + WSAGetLastError (winsock-error) ; : winsock-error=0/f ( n/f -- ) - { 0 f } member? [ throw-winsock-error ] when ; + { 0 f } member? [ winsock-error ] when ; : winsock-error!=0/f ( n/f -- ) - { 0 f } member? [ throw-winsock-error ] unless ; + { 0 f } member? [ winsock-error ] unless ; ! WSAStartup and WSACleanup return the error code directly : winsock-return-check ( n/f -- ) diff --git a/basis/xml-rpc/xml-rpc.factor b/basis/xml-rpc/xml-rpc.factor index 86a67afd17..36bc349e11 100644 --- a/basis/xml-rpc/xml-rpc.factor +++ b/basis/xml-rpc/xml-rpc.factor @@ -125,7 +125,7 @@ TAG: boolean xml>item children>string { { "1" [ t ] } { "0" [ f ] } - [ "Bad boolean" throw-server-error ] + [ "Bad boolean" server-error ] } case ; : unstruct-member ( tag -- ) @@ -167,7 +167,7 @@ TAG: array xml>item dup first-child-tag main>> "fault" = [ parse-fault ] [ parse-rpc-response ] if - ] [ "Bad main tag name" throw-server-error ] if + ] [ "Bad main tag name" server-error ] if ] if ; alist swap '[ _ throw-no-tag ] suffix '[ dup main>> _ case ] ; + >alist swap '[ _ no-tag ] suffix '[ dup main>> _ case ] ; : define-tags ( word effect -- ) [ dup dup "xtable" word-prop compile-tags ] dip define-declared ; diff --git a/core/alien/alien.factor b/core/alien/alien.factor index e02bc08a43..b60331d8cb 100755 --- a/core/alien/alien.factor +++ b/core/alien/alien.factor @@ -86,22 +86,22 @@ UNION: abi stdcall thiscall fastcall cdecl mingw ; ERROR: alien-callback-error ; : alien-callback ( return parameters abi quot -- alien ) - throw-alien-callback-error ; + alien-callback-error ; ERROR: alien-indirect-error ; : alien-indirect ( args... funcptr return parameters abi -- return... ) - throw-alien-indirect-error ; + alien-indirect-error ; ERROR: alien-invoke-error library symbol ; : alien-invoke ( args... return library function parameters -- return... ) - 2over throw-alien-invoke-error ; + 2over alien-invoke-error ; ERROR: alien-assembly-error code ; : alien-assembly ( args... return parameters abi quot -- return... ) - dup throw-alien-assembly-error ; + dup alien-assembly-error ; string ERROR: invalid-c-string string ; : check-string ( string -- ) - 0 over member-eq? [ throw-invalid-c-string ] [ drop ] if ; + 0 over member-eq? [ invalid-c-string ] [ drop ] if ; GENERIC# string>alien 1 ( string encoding -- byte-array ) diff --git a/core/classes/algebra/algebra.factor b/core/classes/algebra/algebra.factor index c4b9cfc7fe..ad386c176e 100644 --- a/core/classes/algebra/algebra.factor +++ b/core/classes/algebra/algebra.factor @@ -17,12 +17,12 @@ ERROR: not-classoids sequence ; : check-classoids ( members -- members ) dup [ classoid? ] all? - [ [ classoid? ] reject throw-not-classoids ] unless ; + [ [ classoid? ] reject not-classoids ] unless ; ERROR: not-a-classoid object ; : check-classoid ( object -- object ) - dup classoid? [ throw-not-a-classoid ] unless ; + dup classoid? [ not-a-classoid ] unless ; : ( members -- classoid ) check-classoids @@ -47,7 +47,7 @@ TUPLE: anonymous-complement { class read-only } ; INSTANCE: anonymous-complement classoid : ( object -- classoid ) - dup classoid? [ 1array throw-not-classoids ] unless + dup classoid? [ 1array not-classoids ] unless anonymous-complement boa ; M: anonymous-complement rank-class drop 3 ; @@ -283,7 +283,7 @@ ERROR: topological-sort-failed ; : largest-class ( seq -- n elt ) dup [ [ class< ] with any? not ] curry find-last - [ throw-topological-sort-failed ] unless* ; + [ topological-sort-failed ] unless* ; : sort-classes ( seq -- newseq ) [ class-name ] sort-with >vector diff --git a/core/classes/builtin/builtin.factor b/core/classes/builtin/builtin.factor index 9a2469f70b..72178f62f2 100644 --- a/core/classes/builtin/builtin.factor +++ b/core/classes/builtin/builtin.factor @@ -12,7 +12,7 @@ PREDICATE: builtin-class < class ERROR: not-a-builtin object ; : check-builtin ( class -- ) - dup builtin-class? [ drop ] [ throw-not-a-builtin ] if ; + dup builtin-class? [ drop ] [ not-a-builtin ] if ; : class>type ( class -- n ) "type" word-prop ; foldable diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 9e39b40923..8c65a5d10b 100644 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -225,7 +225,7 @@ GENERIC: update-methods ( class seq -- ) [ nip [ update-class ] each ] [ update-methods ] 2bi ; : check-inheritance ( subclass superclass -- ) - 2dup superclass-of? [ throw-bad-inheritance ] [ 2drop ] if ; + 2dup superclass-of? [ bad-inheritance ] [ 2drop ] if ; : define-class ( word superclass members participants metaclass -- ) [ 2dup check-inheritance ] 3dip diff --git a/core/classes/error/error-tests.factor b/core/classes/error/error-tests.factor index 80c881d174..a74febc42f 100644 --- a/core/classes/error/error-tests.factor +++ b/core/classes/error/error-tests.factor @@ -8,8 +8,8 @@ IN: classes.error.tests ! Test error classes ERROR: error-class-test a b c ; -{ "( a b c -- * )" } [ \ throw-error-class-test stack-effect effect>string ] unit-test -{ f } [ \ throw-error-class-test "inline" word-prop ] unit-test +{ "( a b c -- * )" } [ \ error-class-test stack-effect effect>string ] unit-test +{ f } [ \ error-class-test "inline" word-prop ] unit-test [ "IN: classes.error.tests ERROR: error-x ; : error-x 3 ;" eval( -- ) ] [ error>> error>> redefine-error? ] must-fail-with @@ -37,4 +37,4 @@ DEFER: error-y ERROR: base-error x y ; ERROR: derived-error < base-error z ; -{ ( x y z -- * ) } [ \ throw-derived-error stack-effect ] unit-test +{ ( x y z -- * ) } [ \ derived-error stack-effect ] unit-test diff --git a/core/classes/error/error.factor b/core/classes/error/error.factor index ca9d0bab65..2c050a4c93 100644 --- a/core/classes/error/error.factor +++ b/core/classes/error/error.factor @@ -22,11 +22,4 @@ M: error-class reset-class [ all-slots thrower-effect ] tri define-declared ] - [ - 2drop - [ name>> "throw-" prepend create-word-in [ reset-generic ] keep ] - [ [ boa throw ] curry ] - [ all-slots thrower-effect ] - tri define-declared - ] } 3cleave ; diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index f73c1059a8..bacb34a385 100644 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -22,7 +22,7 @@ ERROR: check-mixin-class-error class ; : check-mixin-class ( mixin -- mixin ) dup mixin-class? [ - throw-check-mixin-class-error + check-mixin-class-error ] unless ; object swap slots>tuple ; : check-slot-exists ( class initials slot-spec/f index/f name -- class initials slot-spec index ) - over [ drop ] [ nip nip nip throw-bad-slot-name ] if ; + over [ drop ] [ nip nip nip bad-slot-name ] if ; : slot-named-checked ( class initials name slots -- class initials slot-spec ) over [ slot-named* ] dip check-slot-exists drop ; @@ -112,7 +112,7 @@ M: tuple-class boa>object { "f" [ drop \ } parse-until boa>object ] } { "{" [ 2dup parse-slot-values assoc>object ] } { "}" [ drop new ] } - [ throw-bad-literal-tuple ] + [ bad-literal-tuple ] } case ; : parse-tuple-literal ( -- tuple ) diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 6c1bcf7527..37e93e0056 100644 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -24,7 +24,7 @@ ERROR: no-slot name tuple ; : offset-of-slot ( name tuple -- n ) 2dup class-of all-slots slot-named - [ 2nip offset>> ] [ throw-no-slot ] if* ; + [ 2nip offset>> ] [ no-slot ] if* ; : get-slot-named ( name tuple -- value ) [ nip ] [ offset-of-slot ] 2bi slot ; @@ -59,7 +59,7 @@ M: tuple class-of layout-of 2 slot { word } declare ; inline [ [ layout-of ] [ class-of tuple-layout ] bi eq? ] [ drop t ] if ; : check-tuple ( object -- tuple ) - dup tuple? [ throw-not-a-tuple ] unless ; inline + dup tuple? [ not-a-tuple ] unless ; inline : prepare-tuple-slots ( tuple -- n tuple ) check-tuple [ tuple-size iota ] keep ; @@ -324,7 +324,7 @@ M: tuple-class (define-tuple-class) ERROR: not-a-tuple-class object ; : check-tuple-class ( class -- class ) - dup tuple-class? [ throw-not-a-tuple-class ] unless ; inline + dup tuple-class? [ not-a-tuple-class ] unless ; inline : define-boa-word ( word class -- ) check-tuple-class [ [ boa ] curry ] [ boa-effect ] bi diff --git a/core/classes/union/union.factor b/core/classes/union/union.factor index b375b20b4c..0e4cf5742a 100644 --- a/core/classes/union/union.factor +++ b/core/classes/union/union.factor @@ -68,7 +68,7 @@ M: object classes-contained-by dup dup [ classes-contained-by ] map concat sift append 2dup set= [ 2drop f ] [ nip ] if ] follow concat - member-eq? [ throw-cannot-reference-self ] when ; + member-eq? [ cannot-reference-self ] when ; PRIVATE> diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor index 9d43d4c7e4..f348155d36 100644 --- a/core/combinators/combinators.factor +++ b/core/combinators/combinators.factor @@ -38,7 +38,7 @@ SLOT: terminated? check-datastack ] if ] 2dip rot - [ 2drop ] [ throw-wrong-values ] if ; + [ 2drop ] [ wrong-values ] if ; : execute-effect ( word effect -- ) [ [ execute ] curry ] dip call-effect ; diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 78911cea79..552143b7ff 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -52,7 +52,7 @@ C: continuation ERROR: not-a-continuation object ; : >continuation< ( continuation -- data call retain name catch ) - dup continuation? [ throw-not-a-continuation ] unless + dup continuation? [ not-a-continuation ] unless { [ data>> ] [ call>> ] [ retain>> ] [ name>> ] [ catch>> ] } cleave ; inline PRIVATE> diff --git a/core/definitions/definitions.factor b/core/definitions/definitions.factor index 4fdae1da75..350268630c 100644 --- a/core/definitions/definitions.factor +++ b/core/definitions/definitions.factor @@ -8,7 +8,7 @@ MIXIN: definition-mixin ERROR: no-compilation-unit definition ; : add-to-unit ( key set -- ) - [ adjoin ] [ throw-no-compilation-unit ] if* ; + [ adjoin ] [ no-compilation-unit ] if* ; SYMBOL: changed-definitions diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index fc79a193df..3e4eaeeec9 100755 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -19,7 +19,7 @@ SLOT: continuation disposables get adjoin ; : unregister-disposable ( obj -- ) - disposables get 2dup in? [ delete ] [ drop throw-already-unregistered ] if ; + disposables get 2dup in? [ delete ] [ drop already-unregistered ] if ; PRIVATE> diff --git a/core/effects/effects.factor b/core/effects/effects.factor index 2e9d668321..c1288052b1 100644 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -132,4 +132,4 @@ ERROR: bad-stack-effect word expected got ; : check-stack-effect ( word effect -- ) over stack-effect 2dup effect= - [ 3drop ] [ throw-bad-stack-effect ] if ; + [ 3drop ] [ bad-stack-effect ] if ; diff --git a/core/effects/parser/parser.factor b/core/effects/parser/parser.factor index aed4e2f3ea..2a9246c1b2 100644 --- a/core/effects/parser/parser.factor +++ b/core/effects/parser/parser.factor @@ -21,8 +21,8 @@ SYMBOL: effect-var : parse-effect-var ( first? var name -- var ) nip - [ ":" ?tail [ throw-row-variable-can't-have-type ] when ] curry - [ throw-invalid-row-variable ] if ; + [ ":" ?tail [ row-variable-can't-have-type ] when ] curry + [ invalid-row-variable ] if ; : parse-effect-value ( token -- value ) ":" ?tail [ scan-object 2array ] when ; @@ -31,8 +31,8 @@ PRIVATE> : parse-effect-token ( first? var end -- var more? ) scan-token { { [ end-token? ] [ drop nip f ] } - { [ effect-opener? ] [ throw-bad-effect ] } - { [ effect-closer? ] [ throw-stack-effect-omits-dashes ] } + { [ effect-opener? ] [ bad-effect ] } + { [ effect-closer? ] [ stack-effect-omits-dashes ] } { [ row-variable? ] [ parse-effect-var t ] } [ [ drop ] 2dip parse-effect-value , t ] } cond ; diff --git a/core/generic/generic.factor b/core/generic/generic.factor index cd773a89f1..c861f7c54b 100644 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -30,7 +30,7 @@ ERROR: method-lookup-failed class generic ; "methods" word-prop at ; : lookup-method ( class generic -- method ) - 2dup ?lookup-method [ 2nip ] [ throw-method-lookup-failed ] if* ; + 2dup ?lookup-method [ 2nip ] [ method-lookup-failed ] if* ; ERROR: no-math-method left right generic ; : default-math-method ( generic -- quot ) - [ throw-no-math-method ] curry [ ] like ; + [ no-math-method ] curry [ ] like ; ( string -- byte-array ) M: string ascii> dup aux>> - [ [ dup 127 <= [ throw-encode-error ] unless ] B{ } map-as ] + [ [ dup 127 <= [ encode-error ] unless ] B{ } map-as ] [ string>byte-array-fast ] if ; inline PRIVATE> diff --git a/core/io/encodings/utf16/utf16.factor b/core/io/encodings/utf16/utf16.factor index 13406a23f1..0660ddfd77 100644 --- a/core/io/encodings/utf16/utf16.factor +++ b/core/io/encodings/utf16/utf16.factor @@ -139,7 +139,7 @@ CONSTANT: bom-be B{ 0xfe 0xff } : bom>le/be ( bom -- le/be ) dup bom-le sequence= [ drop utf16le ] [ - bom-be sequence= [ utf16be ] [ throw-missing-bom ] if + bom-be sequence= [ utf16be ] [ missing-bom ] if ] if ; M: utf16 ( stream utf16 -- decoder ) diff --git a/core/io/pathnames/pathnames.factor b/core/io/pathnames/pathnames.factor index d96bcf6d20..2d382e49d1 100644 --- a/core/io/pathnames/pathnames.factor +++ b/core/io/pathnames/pathnames.factor @@ -35,7 +35,7 @@ ERROR: no-parent-directory path ; drop "." swap ] if { "" "." ".." } member? [ - throw-no-parent-directory + no-parent-directory ] when ] unless ; @@ -57,7 +57,7 @@ ERROR: no-parent-directory path ; { [ dup head.? ] [ rest trim-head-separators append-path-empty ] } - { [ dup head..? ] [ drop throw-no-parent-directory ] } + { [ dup head..? ] [ drop no-parent-directory ] } [ nip ] } cond ; diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index 09d2f69bad..49a227b76f 100644 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -304,7 +304,7 @@ GENERIC: throw ( error -- * ) ERROR: assert got expect ; -: assert= ( a b -- ) 2dup = [ 2drop ] [ throw-assert ] if ; +: assert= ( a b -- ) 2dup = [ 2drop ] [ assert ] if ; ERROR: log2-expects-positive x ; : log2 ( x -- n ) - dup 0 <= [ throw-log2-expects-positive ] [ (log2) ] if ; inline + dup 0 <= [ log2-expects-positive ] [ (log2) ] if ; inline : zero? ( x -- ? ) 0 number= ; inline : 2/ ( x -- y ) -1 shift ; inline diff --git a/core/math/parser/parser.factor b/core/math/parser/parser.factor index 4cc773e0ee..de8f60ce1d 100644 --- a/core/math/parser/parser.factor +++ b/core/math/parser/parser.factor @@ -454,7 +454,7 @@ M: fixnum (positive>dec) 1 over (count-digits) (fixnum>dec) "" like reverse! nip ; inline : (positive>base) ( num radix -- str ) - dup 1 <= [ throw-invalid-radix ] when + dup 1 <= [ invalid-radix ] when [ dup 0 > ] swap [ /mod >digit ] curry "" produce-as nip reverse! ; inline @@ -534,7 +534,7 @@ M: ratio >base { 16 [ [ float>hex-value ] swap (bin-float>base) ] } { 8 [ [ float>oct-value ] swap (bin-float>base) ] } { 2 [ [ float>bin-value ] swap (bin-float>base) ] } - [ throw-invalid-radix ] + [ invalid-radix ] } case ; : format-string ( format -- format ) diff --git a/core/math/ratios/ratios.factor b/core/math/ratios/ratios.factor index 71d0aebcc9..167d335b9b 100644 --- a/core/math/ratios/ratios.factor +++ b/core/math/ratios/ratios.factor @@ -26,7 +26,7 @@ ERROR: division-by-zero x ; M: integer / [ - throw-division-by-zero + division-by-zero ] [ dup 0 < [ [ neg ] bi@ ] when 2dup fast-gcd [ /i ] curry bi@ fraction> @@ -34,7 +34,7 @@ M: integer / M: integer recip 1 swap [ - throw-division-by-zero + division-by-zero ] [ dup 0 < [ [ neg ] bi@ ] when fraction> ] if-zero ; diff --git a/core/parser/parser.factor b/core/parser/parser.factor index 990d00d9f2..91dea25487 100644 --- a/core/parser/parser.factor +++ b/core/parser/parser.factor @@ -53,7 +53,7 @@ SYMBOL: auto-use? ERROR: number-expected ; : parse-number ( string -- number ) - string>number [ throw-number-expected ] unless* ; + string>number [ number-expected ] unless* ; : parse-datum ( string -- word/number ) dup search [ ] [ @@ -77,7 +77,7 @@ ERROR: invalid-word-name string ; : scan-word-name ( -- string ) scan-token dup "\"" = [ t ] [ dup string>number ] if - [ throw-invalid-word-name ] when ; + [ invalid-word-name ] when ; : scan-new ( -- word ) scan-word-name create-word-in ; @@ -93,7 +93,7 @@ ERROR: staging-violation word ; pop-parsing-word ; inline : execute-parsing ( accum word -- accum ) - dup changed-definitions get in? [ throw-staging-violation ] when + dup changed-definitions get in? [ staging-violation ] when (execute-parsing) ; : scan-object ( -- object ) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index d5d6ddc3d0..a2ab3ee8e2 100644 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -57,13 +57,13 @@ M: integer bounds-check? ( n seq -- ? ) dupd length < [ 0 >= ] [ drop f ] if ; inline : bounds-check ( n seq -- n seq ) - 2dup bounds-check? [ throw-bounds-error ] unless ; inline + 2dup bounds-check? [ bounds-error ] unless ; inline MIXIN: immutable-sequence ERROR: immutable element index sequence ; -M: immutable-sequence set-nth throw-immutable ; +M: immutable-sequence set-nth immutable ; INSTANCE: immutable-sequence sequence @@ -304,7 +304,7 @@ C: copy-state 3dup nip new-sequence 0 swap ; inline : bounds-check-head ( n seq -- n seq ) - over 0 < [ throw-bounds-error ] when ; inline + over 0 < [ bounds-error ] when ; inline : check-copy ( src n dst -- src n dst ) 3dup bounds-check-head @@ -742,7 +742,7 @@ PRIVATE> : last ( seq -- elt ) [ length 1 - ] keep - over 0 < [ throw-bounds-error ] [ nth-unsafe ] if ; inline + over 0 < [ bounds-error ] [ nth-unsafe ] if ; inline : set-last ( elt seq -- ) [ length 1 - ] keep - over 0 < [ throw-bounds-error ] [ set-nth-unsafe ] if ; inline + over 0 < [ bounds-error ] [ set-nth-unsafe ] if ; inline : pop* ( seq -- ) [ length 1 - ] [ shorten ] bi ; @@ -814,7 +814,7 @@ PRIVATE> : pop ( seq -- elt ) [ length 1 - ] keep over 0 >= [ [ nth-unsafe ] [ shorten ] 2bi ] - [ throw-bounds-error ] if ; + [ bounds-error ] if ; : exchange ( m n seq -- ) [ nip bounds-check 2drop ] diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 22d3e1068e..e3f6ea995b 100644 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -83,7 +83,7 @@ M: object instance-check-quot [ \ dup , [ predicate-def % ] - [ [ throw-bad-slot-value ] curry , ] bi + [ [ bad-slot-value ] curry , ] bi \ unless , ] [ ] make ; @@ -241,7 +241,7 @@ ERROR: bad-slot-attribute key ; unclip { { initial: [ [ first >>initial ] [ rest ] bi ] } { read-only [ [ t >>read-only ] dip ] } - [ throw-bad-slot-attribute ] + [ bad-slot-attribute ] } case ] unless ; diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor index dbdd042778..2575ea686f 100644 --- a/core/source-files/source-files.factor +++ b/core/source-files/source-files.factor @@ -33,7 +33,7 @@ main ; ERROR: invalid-source-file-path path ; : path>source-file ( path -- source-file ) - dup string? [ throw-invalid-source-file-path ] unless + dup string? [ invalid-source-file-path ] unless source-files get [ ] cache ; : reset-checksums ( -- ) diff --git a/core/strings/parser/parser.factor b/core/strings/parser/parser.factor index 86f6030b05..97ee6836f0 100644 --- a/core/strings/parser/parser.factor +++ b/core/strings/parser/parser.factor @@ -22,7 +22,7 @@ ERROR: bad-escape char ; { CHAR: 0 CHAR: \0 } { CHAR: \\ CHAR: \\ } { CHAR: \" CHAR: \" } - } ?at [ throw-bad-escape ] unless ; + } ?at [ bad-escape ] unless ; SYMBOL: name>char-hook @@ -116,7 +116,7 @@ ERROR: escaped-char-expected ; dup still-parsing-line? [ [ current-char ] [ advance-char ] bi ] [ - throw-escaped-char-expected + escaped-char-expected ] if ; : lexer-head? ( lexer string -- ? ) diff --git a/core/syntax/syntax-docs.factor b/core/syntax/syntax-docs.factor index 9b9b47f542..97d3cdcdac 100644 --- a/core/syntax/syntax-docs.factor +++ b/core/syntax/syntax-docs.factor @@ -823,7 +823,7 @@ HELP: SLOT: HELP: ERROR: { $syntax "ERROR: class slots... ;" } { $values { "class" "a new tuple class to define" } { "slots" "a list of slot names" } } -{ $description "Defines a new tuple class and a word " { $snippet "throw-classname" } " that throws a new instance of the error." } +{ $description "Defines a new tuple class and a word " { $snippet "classname" } " that throws a new instance of the error." } { $notes "The following two snippets are equivalent:" { $code diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index 8a99364675..55f8561a47 100644 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -31,7 +31,7 @@ IN: bootstrap.syntax : define-core-syntax ( name quot -- ) [ - dup "syntax" lookup-word [ ] [ throw-no-word-error ] ?if + dup "syntax" lookup-word [ ] [ no-word-error ] ?if mark-top-level-syntax ] dip define-syntax ; @@ -261,7 +261,7 @@ IN: bootstrap.syntax literalize suffix! \ (call-next-method) suffix! ] [ - throw-not-in-a-method-error + not-in-a-method-error ] if* ] define-core-syntax diff --git a/core/vocabs/loader/loader-docs.factor b/core/vocabs/loader/loader-docs.factor index e17f85461b..1088baf9a5 100755 --- a/core/vocabs/loader/loader-docs.factor +++ b/core/vocabs/loader/loader-docs.factor @@ -93,7 +93,7 @@ HELP: find-vocab-root HELP: no-vocab { $values { "name" "a vocabulary name" } } -{ $description "A " { $link no-vocab } " error tuple. Call " { $link throw-no-vocab } " to throw it." } +{ $description "A " { $link no-vocab } " error tuple. Call " { $link no-vocab } " to throw it." } { $error-description "Thrown when a " { $link POSTPONE: USE: } " or " { $link POSTPONE: USING: } " form refers to a non-existent vocabulary." } ; HELP: load-help? diff --git a/core/vocabs/loader/loader.factor b/core/vocabs/loader/loader.factor index 17de3f26d4..1de8ecabd5 100644 --- a/core/vocabs/loader/loader.factor +++ b/core/vocabs/loader/loader.factor @@ -36,7 +36,7 @@ ERROR: not-found-in-roots path ; vocab-roots get [ prepend-path exists? ] with find nip ; M: string vocab-path ( string -- path/f ) - dup find-root-for [ prepend-path ] [ throw-not-found-in-roots ] if* ; + dup find-root-for [ prepend-path ] [ not-found-in-roots ] if* ; PRIVATE> @@ -165,7 +165,7 @@ PRIVATE> [ drop dup find-vocab-root [ (require) ] - [ dup lookup-vocab [ drop ] [ throw-no-vocab ] if ] + [ dup lookup-vocab [ drop ] [ no-vocab ] if ] if ] if ] require-hook set-global diff --git a/core/vocabs/parser/parser.factor b/core/vocabs/parser/parser.factor index f7a18a2c53..5cf59fdaf5 100644 --- a/core/vocabs/parser/parser.factor +++ b/core/vocabs/parser/parser.factor @@ -58,7 +58,7 @@ ERROR: no-word-in-vocab word vocab ; : extract-words ( seq vocab -- assoc ) [ words>> extract-keys dup ] [ name>> ] bi - [ swap [ 2drop ] [ throw-no-word-in-vocab ] if ] curry assoc-each ; + [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ; : excluding-words ( seq vocab -- assoc ) [ nip words>> ] [ extract-words ] 2bi assoc-diff ; @@ -98,13 +98,13 @@ ERROR: unbalanced-private-declaration vocab ; : begin-private ( -- ) current-vocab name>> ".private" ?tail - [ throw-unbalanced-private-declaration ] + [ unbalanced-private-declaration ] [ ".private" append set-current-vocab ] if ; : end-private ( -- ) current-vocab name>> ".private" ?tail [ set-current-vocab ] - [ throw-unbalanced-private-declaration ] if ; + [ unbalanced-private-declaration ] if ; : using-vocab? ( vocab -- ? ) vocab-name manifest get search-vocab-names>> in? ; @@ -161,7 +161,7 @@ TUPLE: rename word vocab words ; : ( word vocab new-name -- rename ) [ 2dup load-vocab words>> dupd at - [ ] [ swap throw-no-word-in-vocab ] ?if + [ ] [ swap no-word-in-vocab ] ?if ] dip associate rename boa ; : add-renamed-word ( word vocab new-name -- ) diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor index a3389cd2ea..66f706eac7 100644 --- a/core/vocabs/vocabs.factor +++ b/core/vocabs/vocabs.factor @@ -24,8 +24,8 @@ SYMBOL: +done+ ERROR: bad-vocab-name name ; : check-vocab-name ( name -- name ) - dup string? [ throw-bad-vocab-name ] unless - dup [ ":/\\ " member? ] any? [ throw-bad-vocab-name ] when ; + dup string? [ bad-vocab-name ] unless + dup [ ":/\\ " member? ] any? [ bad-vocab-name ] when ; TUPLE: vocab-link name ; diff --git a/core/words/words.factor b/core/words/words.factor index 6cafb20f8f..c41ecb16b9 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -80,7 +80,7 @@ ERROR: invalid-primitive vocabulary word effect ; [ drop vocabulary>> = ] [ drop nip primitive? ] [ [ nip "declared-effect" word-prop ] dip = ] 3tri and and - [ 3drop ] [ throw-invalid-primitive ] if ; + [ 3drop ] [ invalid-primitive ] if ; : lookup-word ( name vocab -- word ) vocab-words-assoc at ; @@ -216,13 +216,13 @@ M: word reset-word : reveal ( word -- ) dup [ name>> ] [ vocabulary>> ] bi dup vocab-words-assoc - [ ] [ throw-no-vocab ] ?if set-at ; + [ ] [ no-vocab ] ?if set-at ; ERROR: bad-create name vocab ; : check-create ( name vocab -- name vocab ) 2dup [ string? ] [ [ string? ] [ vocab? ] bi or ] bi* and - [ throw-bad-create ] unless ; + [ bad-create ] unless ; : create-word ( name vocab -- word ) check-create 2dup lookup-word diff --git a/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor b/extra/alien/cxx/demangle/libstdcxx/libstdcxx.factor index 43e33d3991..3487423504 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 throw-demangle-memory-allocation-failure ] } - { -2 [ throw-invalid-mangled-name ] } - { -3 [ throw-invalid-demangle-args ] } + { -1 [ drop demangle-memory-allocation-failure ] } + { -2 [ invalid-mangled-name ] } + { -3 [ invalid-demangle-args ] } } case ; : mangled-name? ( name -- ? ) diff --git a/extra/alien/fortran/fortran.factor b/extra/alien/fortran/fortran.factor index 2d5d98d01f..34405c6c87 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 ) - [ throw-invalid-fortran-type ] suffix + [ invalid-fortran-type ] suffix '[ [ size>> _ case ] [ append-dimensions ] bi ] ; : simple-type ( type base-c-type -- c-type ) swap - [ dup size>> [ throw-invalid-fortran-type ] [ drop ] if ] + [ dup size>> [ 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>> [ throw-invalid-fortran-type ] [ dup size>> 1array >>dims f >>size ] if ] + [ dup dims>> [ 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 ] ] } - [ throw-invalid-fortran-type ] + [ 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 ] ] } - [ throw-invalid-fortran-type ] + [ invalid-fortran-type ] } case ] args?dims ; @@ -235,7 +235,7 @@ M: real-complex-type (fortran-arg>c-args) { f [ [ ] [ drop ] ] } { 8 [ [ ] [ drop ] ] } { 16 [ [ ] [ drop ] ] } - [ throw-invalid-fortran-type ] + [ 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 ] } ] } - [ throw-invalid-fortran-type ] + [ 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 ] } ] } - [ throw-invalid-fortran-type ] + [ 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 ] } ] } - [ throw-invalid-fortran-type ] + [ 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 b411ebd132..70f985c78d 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? [ throw-no-negative-shape-components ] when ; + dup [ 0 < ] any? [ 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 - throw-no-abnormally-shaped-arrays ; + no-abnormally-shaped-arrays ; M: uniform-shape check-underlying-shape shape>> check-underlying-shape ; M: sequence check-underlying-shape 2dup [ length ] [ shape-capacity ] bi* - = [ throw-underlying-shape-mismatch ] unless ; inline + = [ underlying-shape-mismatch ] unless ; inline ERROR: shape-mismatch shaped0 shaped1 ; : check-shape ( shaped-array shaped-array -- shaped-array shaped-array ) 2dup [ shape>> ] bi@ - sequence= [ throw-shape-mismatch ] unless ; + sequence= [ 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 40819a1302..ad86a8877d 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 throw-unsupported-tag-encoding + get-id unsupported-tag-encoding ] unless ; : set-tagclass ( -- ) diff --git a/extra/audio/audio.factor b/extra/audio/audio.factor index fcd36a27bb..dab3be1363 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 throw-format-unsupported-by-openal ] + [ drop format-unsupported-by-openal ] } case ; diff --git a/extra/audio/chunked-file/chunked-file.factor b/extra/audio/chunked-file/chunked-file.factor index 01f2d9b109..271e56b171 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 [ throw-invalid-audio-file ] unless* ; + ensured-read [ 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 16d82ca55e..5da13cd33e 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 throw-audio-device-not-found ] unless + al-device [ device-name audio-device-not-found ] unless al-device |alcCloseDevice* drop al-device f alcCreateContext :> al-context - al-context [ device-name throw-audio-context-not-available ] unless + al-context [ device-name 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 ba2a346f7d..d1cb43aa3c 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 ) ] - [ throw-unknown-audio-extension ] if ; + [ 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 eae8b48509..d8036b4ee0 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 < [ throw-ogg-error ] [ drop ] if ; inline + dup 0 < [ 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 -- ) - [ throw-vorbis-error ] unless-zero ; inline + [ vorbis-error ] unless-zero ; inline : get-remaining-vorbis-header-packet ( player -- ? ) [ stream-state>> ] [ packet>> ] bi ogg_stream_packetout { - { [ dup 0 < ] [ throw-vorbis-error ] } + { [ dup 0 < ] [ 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? - [ throw-no-vorbis-in-ogg ] + [ 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 7dc686ea24..a87a031e00 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 ] [ throw-amb-failure ] if* ; + failure get [ continue ] [ amb-failure ] if* ; : must-be-true ( ? -- ) [ fail ] unless ; diff --git a/extra/base85/base85.factor b/extra/base85/base85.factor index e2d5f1cf6d..fb8efb2e2c 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 - [ throw-malformed-base85 ] unless* ; inline + [ 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) ] } - [ throw-malformed-base85 ] + [ malformed-base85 ] } case ; PRIVATE> diff --git a/extra/benchmark/chameneos-redux/chameneos-redux.factor b/extra/benchmark/chameneos-redux/chameneos-redux.factor index 83839398c9..bcc0e85620 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 ] } - [ throw-bad-color-pair ] + [ bad-color-pair ] } case ] if ; diff --git a/extra/benchmark/tcp-echo0/tcp-echo0.factor b/extra/benchmark/tcp-echo0/tcp-echo0.factor index 05a7066bde..60500b3aa8 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 = [ throw-incorrect-#bytes ] unless ; + over length = [ 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? [ throw-incorrect-#bytes ] unless + contents empty? [ incorrect-#bytes ] unless ] with-client ] with-threaded-server ; diff --git a/extra/bit/ly/ly.factor b/extra/bit/ly/ly.factor index 036ec55d40..f69eff34b0 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 - throw-bad-response + bad-response ] unless ; : json-data ( url -- json ) diff --git a/extra/bloom-filters/bloom-filters.factor b/extra/bloom-filters/bloom-filters.factor index 50a680919e..07ff68703a 100644 --- a/extra/bloom-filters/bloom-filters.factor +++ b/extra/bloom-filters/bloom-filters.factor @@ -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 <= [ throw-invalid-size ] when ; + dup first 0 <= [ 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 <= [ throw-invalid-capacity ] when ; + dup 0 <= [ invalid-capacity ] when ; : check-error-rate ( error-rate -- error-rate ) dup [ 0 after? ] [ 1 before? ] bi and - [ throw-invalid-error-rate ] unless ; + [ invalid-error-rate ] unless ; PRIVATE> diff --git a/extra/bson/reader/reader.factor b/extra/bson/reader/reader.factor index cd00dbb03b..62e76eb42c 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" throw-unknown-bson-type ] + [ "unknown binary sub-type" 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" throw-unknown-bson-type ] + [ "type unknown" 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 c5232240fe..55e11edde5 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 ] } - [ throw-bad-include-line ] + [ 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 ] } - [ throw-unknown-c-preprocessor ] + [ 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 30efcebb24..b08729b7a1 100644 --- a/extra/cairo-demo/cairo-demo.factor +++ b/extra/cairo-demo/cairo-demo.factor @@ -44,7 +44,7 @@ ERROR: no-cairo-t ; > [ throw-no-cairo-t ] unless* + cairo-t>> [ 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 700f5bf38a..49d9d5098c 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? [ throw-repeated-constructor-parameters ] unless + dup in>> all-unique? [ repeated-constructor-parameters ] unless 2dup [ all-slots [ name>> ] map ] [ in>> ] bi* swap diff - [ throw-unknown-constructor-parameters ] unless-empty ; + [ 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 7cf1bb7b5e..1d48355f04 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 ] [ - throw-undefined-8080-opcode + undefined-8080-opcode ] if* ; : process-interrupts ( cpu -- ) diff --git a/extra/crypto/aes/aes.factor b/extra/crypto/aes/aes.factor index 1b1323b131..36c73842c2 100644 --- a/extra/crypto/aes/aes.factor +++ b/extra/crypto/aes/aes.factor @@ -149,7 +149,7 @@ M: aes-128-key key-expand-round ( temp i -- temp' ) ERROR: aes-192-256-not-implemented ; M: aes-256-key key-expand-round ( temp i -- temp' ) - throw-aes-192-256-not-implemented ; + 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 bfeaf9af97..45bbe55d6e 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' ) - [ throw-empty-xor-key ] when-empty + [ 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 54ae4a24ab..9ecaebce29 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 ] [ throw-cuda-error-state ] if ; + dup CUDA_SUCCESS = [ drop ] [ 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 fdf0799aa6..f899d4430d 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 [ throw-no-cuda-library ] unless ; + cuda-libraries get ?at [ no-cuda-library ] unless ; : remove-cuda-library ( name -- library ) - cuda-libraries get ?delete-at [ throw-no-cuda-library ] unless ; + cuda-libraries get ?delete-at [ 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? [ throw-bad-cuda-abi ] unless ; inline + dup cuda-abi? [ 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 443ff21363..c1e35c32ca 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 throw-nvcc-failed ] unless-zero + run-process wait-for-process [ path2 nvcc-failed ] unless-zero path2 cu>ptx ] with-directory ; diff --git a/extra/cuesheet/cuesheet.factor b/extra/cuesheet/cuesheet.factor index b5bd8dbfc7..4b85060a84 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? - [ throw-unknown-filetype ] unless ; + [ unknown-filetype ] unless ; ERROR: unknown-flag flag ; diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index c089cea91f..a6629650ad 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 ) - [ throw-curses-failed ] unless* ; inline -: curses-error ( n -- ) ffi:ERR = [ throw-curses-failed ] when ; + [ curses-failed ] unless* ; inline +: curses-error ( n -- ) ffi:ERR = [ curses-failed ] when ; PRIVATE> @@ -262,7 +262,7 @@ PRIVATE> [ current-window ] dip with-variable ; inline : with-curses ( window quot -- ) - curses-ok? [ throw-unsupported-curses-terminal ] unless + curses-ok? [ unsupported-curses-terminal ] unless [ '[ ffi:initscr curses-pointer-error diff --git a/extra/cursors/cursors.factor b/extra/cursors/cursors.factor index b552ff1360..d4ad091078 100644 --- a/extra/cursors/cursors.factor +++ b/extra/cursors/cursors.factor @@ -69,7 +69,7 @@ M: input-cursor cursor-key-value-unsafe cursor-key-value ; inline M: input-cursor cursor-key-value dup cursor-valid? [ cursor-key-value-unsafe ] - [ throw-invalid-cursor ] if ; inline + [ invalid-cursor ] if ; inline : cursor-key ( cursor -- key ) cursor-key-value drop ; : cursor-value ( cursor -- key ) cursor-key-value nip ; @@ -91,7 +91,7 @@ M: output-cursor set-cursor-value-unsafe set-cursor-value ; inline M: output-cursor set-cursor-value dup cursor-valid? [ set-cursor-value-unsafe ] - [ throw-invalid-cursor ] if ; inline + [ invalid-cursor ] if ; inline ! ! stream cursors diff --git a/extra/decimals/decimals-tests.factor b/extra/decimals/decimals-tests.factor index fc48561e8c..726212b0ea 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 throw-decimal-test-failure ] if ; inline + [ t ] [ D1 D2 quot1 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 23fa3a273d..1d244f0355 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? - [ throw-decimal-types-expected ] unless ; + [ decimal-types-expected ] unless ; M: decimal equal? { diff --git a/extra/descriptive/descriptive.factor b/extra/descriptive/descriptive.factor index ccf29a02c3..112540bc91 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 throw-descriptive-error ] 2curry ; + [ 2 ndip 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 917e1bcb2b..d8e3f6bdf7 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? - [ throw-unsupported-domain-name ] unless + [ 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 0f26a5bbbd..f3ce44dc86 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 ] [ throw-fdb-error ] if ; + dup FDB_RESULT_SUCCESS = [ drop ] [ 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 ] } - [ throw-fdb-error ] + [ fdb-error ] } case ; : fdb-del-kv ( key -- ) diff --git a/extra/forestdb/paths/paths.factor b/extra/forestdb/paths/paths.factor index 79c54b12e0..d27af11e6a 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? [ throw-not-an-fdb-filename ] unless ; + dup fdb-filename? [ not-an-fdb-filename ] unless ; ERROR: not-a-string-number string ; : ?string>number ( string -- n ) - dup string>number dup [ nip ] [ throw-not-a-string-number ] if ; + dup string>number dup [ nip ] [ 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 fe4535957b..7b30d25f0e 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 ] [ throw-display-change-error ] if ; + [ drop ] [ display-change-error ] if ; : non-fullscreen-mode ( monitor-info devmode -- ) [ szDevice>> ] dip f 0 f ChangeDisplaySettingsEx dup DISP_CHANGE_SUCCESSFUL = - [ drop ] [ throw-display-change-error ] if ; + [ drop ] [ 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 throw-unsupported-resolution ] unless* ; + ] find nip [ triple 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 3342aceedd..18773e79a4 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 throw-missing-child ] unless 2nip ] + [ rot dup [ drop missing-child ] unless 2nip ] 2bi ; inline : x@ ( tag attr-name -- attr-value ) [ attr ] - [ rot dup [ drop throw-missing-attr ] unless 2nip ] + [ rot dup [ drop 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 73fa57af8a..d566c512b1 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 - [ throw-unknown-models-extension ] unless second ; + [ unknown-models-extension ] unless second ; : models-encoding ( path -- encoding ) file-extension >lower types get ?at - [ throw-unknown-models-extension ] unless first ; + [ unknown-models-extension ] unless first ; : open-models-file ( path encoding -- stream ) ; diff --git a/extra/google/translate/translate.factor b/extra/google/translate/translate.factor index 2738801ef2..7a7d195137 100644 --- a/extra/google/translate/translate.factor +++ b/extra/google/translate/translate.factor @@ -26,8 +26,8 @@ TUPLE: response-error response error ; : check-response ( response -- response ) "responseStatus" over at { { 200 [ ] } - { 400 [ throw-response-error ] } - [ drop throw-response-error ] + { 400 [ response-error ] } + [ drop response-error ] } case ; : query-response>text ( response -- text ) diff --git a/extra/gopher/gopher.factor b/extra/gopher/gopher.factor index 96d27c99fd..32d81cf378 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" = [ throw-not-a-gopher-url ] unless { + dup protocol>> "gopher" = [ 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 312559e0de..f157e322a8 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 throw-invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform 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 throw-invalid-uniform-type ] unless* >quotation :> value-quot + } at [ uniform 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 a1f514e246..108bfa1076 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 throw-inaccurate-feedback-attribute-error ] unless ; + } 0&& [ vertex-attribute 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 throw-invalid-link-feedback-format-error ] ] [ + [ [ nip invalid-link-feedback-format-error ] ] [ vertex-attributes [ name>> ascii malloc-string ] void*-array{ } map-as :> varying-names @@ -473,7 +473,7 @@ DEFER: [ ] [ source>> ] [ kind>> gl-shader-kind ] tri dup gl-shader-ok? [ swap world get \ shader-instance boa window-resource ] - [ throw-compile-shader-error ] if ; + [ compile-shader-error ] if ; : (link-program) ( program shader-instances -- program-instance ) '[ _ [ handle>> ] map ] @@ -488,7 +488,7 @@ DEFER: dup gl-program-ok? [ [ swap world get \ program-instance boa |dispose dup verify-feedback-format ] with-destructors window-resource - ] [ throw-link-program-error ] if ; + ] [ link-program-error ] if ; : link-program ( program -- program-instance ) dup shaders>> [ ] map (link-program) ; @@ -529,7 +529,7 @@ TUPLE: feedback-format : validate-feedback-format ( sequence -- vertex-format/f ) dup length 1 <= [ [ f ] [ first vertex-format>> ] if-empty ] - [ throw-too-many-feedback-formats-error ] if ; + [ 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 b95f554838..6caf5250ee 100644 --- a/extra/graphviz/render/render.factor +++ b/extra/graphviz/render/render.factor @@ -112,7 +112,7 @@ PRIVATE> { "png" [ ".png" ] } { "tif" [ ".tif" ] } { "tiff" [ ".tif" ] } - [ throw-unsupported-preview-format ] + [ 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 e8721c8785..e48f09d660 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 = [ throw-undefined-find-nth ] when ; inline + pick 0 = [ 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 f17a5975f9..8d03207cd5 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 ] - [ throw-atlas-image-formats-dont-match ] if ; inline + [ 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 61697207cf..2ac2326e32 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 ] } - [ throw-unknown-bitmap-header ] + [ 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 ] } - [ throw-unknown-component-order ] + [ 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 5702a91d7a..13e0cc1ac6 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" throw-unimplemented ; + "GIF87a" 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 [ throw-gif-unexpected-eof ] } - [ throw-unknown-extension ] + { f [ gif-unexpected-eof ] } + [ unknown-extension ] } case ; ERROR: unhandled-data byte ; @@ -197,7 +197,7 @@ ERROR: unhandled-data byte ; ] } { IMAGE-DESCRIPTOR [ read-table-based-image ] } { TRAILER [ f >>loading? ] } - [ throw-unhandled-data ] + [ 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 ] } - [ throw-unsupported-gif-format ] + [ 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?>> [ throw-loading-gif-error ] when ; + dup loading?>> [ 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 611c0308ec..ffd0a7a09d 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= [ - throw-bad-png-header + bad-png-header ] unless drop ; ERROR: bad-checksum ; diff --git a/extra/images/tga/tga.factor b/extra/images/tga/tga.factor index f7b09cf341..c64f4907d8 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? [ throw-bad-tga-header ] unless ; + { 0 1 } member? [ bad-tga-header ] unless ; : read-image-type ( -- byte ) 1 read le> dup - { 0 1 2 3 9 10 11 } member? [ throw-bad-tga-header ] unless ; inline + { 0 1 2 3 9 10 11 } member? [ 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" = [ throw-bad-tga-footer ] unless ; inline + 18 read ascii decode "TRUEVISION-XFILE.\0" = [ bad-tga-footer ] unless ; inline : read-extension-size ( -- ) - 2 read le> 495 = [ throw-bad-tga-extension-size ] unless ; inline + 2 read le> 495 = [ 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? [ throw-bad-tga-timestamp ] unless >>month - 2 read le> dup 31 [1,b] member? [ throw-bad-tga-timestamp ] unless >>day + 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> >>year - 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 + 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 : 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? [ throw-bad-tga-timestamp ] unless >>minute - 2 read le> dup 59 [0,b] member? [ throw-bad-tga-timestamp ] unless >>second ; inline + 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 : 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 = [ 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 + 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 #! 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? [ throw-bad-tga-unsupported ] unless + component-order>> { BGRA BGRA } member? [ 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 c9343396b8..aee3d747d9 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 ] } - [ throw-bad-photometric-interpretation ] + [ bad-photometric-interpretation ] } case ; SINGLETONS: compression @@ -124,7 +124,7 @@ ERROR: bad-compression n ; { 34676 [ compression-sgilog ] } { 34677 [ compression-sgilog24 ] } { 34712 [ compression-jp2000 ] } - [ throw-bad-compression ] + [ 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 ] } - [ throw-bad-resolution-unit ] + [ bad-resolution-unit ] } case ; SINGLETONS: predictor @@ -148,7 +148,7 @@ ERROR: bad-predictor n ; { { 1 [ predictor-none ] } { 2 [ predictor-horizontal-differencing ] } - [ throw-bad-predictor ] + [ bad-predictor ] } case ; SINGLETONS: planar-configuration @@ -159,7 +159,7 @@ ERROR: bad-planar-configuration n ; { { 1 [ planar-configuration-chunky ] } { 2 [ planar-configuration-planar ] } - [ throw-bad-planar-configuration ] + [ 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 ] } - [ throw-bad-sample-format ] + [ 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 ] } - [ throw-bad-extra-samples ] + [ 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 ] } - [ throw-bad-jpeg-proc ] + [ 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 ] } - [ throw-bad-tiff-magic ] + [ 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* [ throw-no-tag ] unless ; + find-tag* [ 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" throw-unknown-ifd-type ] + [ "value-length" 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 ] } - [ throw-bad-small-ifd-type ] + [ 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" throw-unknown-ifd-type ] + [ "offset-bytes>obj" 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 ] } - [ throw-unhandled-compression ] + [ unhandled-compression ] } case ; : uncompress-strips ( ifd -- ifd ) @@ -483,7 +483,7 @@ ERROR: unhandled-compression compression ; { { predictor-none [ ] } { predictor-horizontal-differencing [ (strips-predictor) ] } - [ throw-bad-predictor ] + [ bad-predictor ] } case ] when ; @@ -499,7 +499,7 @@ ERROR: unknown-component-order ifd ; { { 8 8 8 8 } [ ] } { { 8 8 8 } [ ] } { 8 [ ] } - [ throw-unknown-component-order ] + [ 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 ] } - [ throw-unknown-component-order ] + [ 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 [ ] } - [ throw-bad-extra-samples ] + [ bad-extra-samples ] } case ; : ifd>image ( ifd -- image ) diff --git a/extra/imap/imap-tests.factor b/extra/imap/imap-tests.factor index 511c2fa3f2..d79270cb56 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>> [ throw-no-imap-test-host ] unless* ; + \ imap-settings get-global host>> [ 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 77d7a0c736..2436af9b32 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 [ throw-imap4-error ] [ 2drop ] if ; + over "OK" = not [ 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 83611aaa77..45ea18b128 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 - [ throw-local-not-defined ] unless ; + [ local-not-defined ] unless ; ERROR: invalid-op string ; @@ -28,7 +28,7 @@ ERROR: invalid-op string ; { "/" [ [ / ] ] } { "%" [ [ mod ] ] } { "**" [ [ ^ ] ] } - [ throw-invalid-op ] + [ 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 13a9f1df02..64206a7cd5 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 > [ throw-bad-length ] when ; inline + 2dup [ length ] dip > [ 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 c757d3c40e..38a2a003f6 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? [ throw-bad-acl-tag-t ] unless + dup 0 2 between? [ 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 247e52b98e..c26be9572c 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 throw-acl-init-failed ] unless ; + n acl_init dup [ n 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 bc6c7c5ffe..2077c64610 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 < ] [ throw-invalid-file-size ] } + { [ over 0 < ] [ 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 558402df94..5dc03fae72 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 throw-invalid-ipv4 ] + [ drop invalid-ipv4 ] } case bubble nip ; inline PRIVATE> diff --git a/extra/machine-learning/rebalancing/rebalancing.factor b/extra/machine-learning/rebalancing/rebalancing.factor index df9c19beb8..41c3296eee 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 ~ [ throw-probability-sum-not-one ] unless ; + dup sum 1.0 .00000000001 ~ [ 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 2388c42ff7..65157c7914 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 throw-not-fat-binary ] + [ 2drop 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 3a0b4ad774..b7a73c4832 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 throw-already-logged-in ; +M: managed-server handle-already-logged-in 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 [ throw-no-such-client ] [ (send-client) ] if ; + clients ?at [ 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 2bfda23a75..d01dff72d5 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 [ throw-no-host-name ] unless* ; + host-name "." split1 drop [ no-host-name ] unless* ; SYMBOL: current-git-id diff --git a/extra/math/derivatives/derivatives.factor b/extra/math/derivatives/derivatives.factor index 29465ffd1a..9d74bdc750 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 throw-undefined-derivative ] } + { +eq+ [ 0 \ abs undefined-derivative ] } { +gt+ [ ] } } case ] ; diff --git a/extra/math/matrices/laplace/laplace.factor b/extra/math/matrices/laplace/laplace.factor index 86b12231e1..817fa89d9a 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? [ throw-not-a-square-matrix ] unless ; inline + dup square-matrix? [ not-a-square-matrix ] unless ; inline PRIVATE> diff --git a/extra/math/transforms/fft/fft.factor b/extra/math/transforms/fft/fft.factor index d7cdfe47c2..b887b55a53 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' ) - [ throw-not-enough-data ] [ f (fft) ] if-empty ; + [ not-enough-data ] [ f (fft) ] if-empty ; : ifft ( seq -- seq' ) - [ throw-not-enough-data ] [ t (fft) ] if-empty ; + [ 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 5561fdad9c..8ff2a03de3 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 [ 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 ] } + { 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 ] } [ drop ] } case ; diff --git a/extra/memory/piles/piles.factor b/extra/memory/piles/piles.factor index 778dd8e7fb..d635b4d83c 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 + - < [ throw-not-enough-pile-space ] [ drop ] if + < [ not-enough-pile-space ] [ drop ] if ] [ drop [ offset>> ] [ underlying>> ] bi ] [ diff --git a/extra/metar/metar.factor b/extra/metar/metar.factor index a874da893d..54c26dfab4 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 throw-bad-location ] + [ drop bad-location ] } case ; : string>longitude ( str -- lon/f ) diff --git a/extra/money/money.factor b/extra/money/money.factor index 431f250a2c..a3ac4ebb13 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 ] [ throw-not-an-integer ] if* ] bi@ + [ dup string>number [ nip ] [ 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 3b2ce203bc..30096bdaeb 100644 --- a/extra/mongodb/connection/connection.factor +++ b/extra/mongodb/connection/connection.factor @@ -150,7 +150,7 @@ ERROR: mongod-connection-error address message ; open-connection [ authenticate-connection ] keep ] [ drop nip address>> "Could not open connection to mongod" - throw-mongod-connection-error + mongod-connection-error ] recover ; : mdb-close ( mdb-connection -- ) diff --git a/extra/mongodb/driver/driver.factor b/extra/mongodb/driver/driver.factor index a0ca3fd54a..bfad87b739 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 db86cdb32c..86c599137b 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 ] } - [ throw-no-morse-ch ] + [ no-morse-ch ] } case ] interleave ; diff --git a/extra/msgpack/msgpack.factor b/extra/msgpack/msgpack.factor index 1519d43859..021a96c3bb 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 ] } - [ throw-unknown-format ] + [ 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 ] } - [ throw-cannot-convert ] + [ 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 ] } - [ throw-cannot-convert ] + [ 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 ] } - [ throw-cannot-convert ] + [ 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 ] } - [ throw-cannot-convert ] + [ 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 ] } - [ throw-cannot-convert ] + [ 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 ] } - [ throw-cannot-convert ] + [ cannot-convert ] } cond ; M: assoc write-msgpack diff --git a/extra/noise/noise.factor b/extra/noise/noise.factor index 0ff11df213..aa62a4391d 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&& - [ throw-invalid-perlin-noise-table ] unless ; + [ 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 f9b7dde262..4f4e5fb7e1 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 ] [ throw-cl-error ] if ; + dup CL_SUCCESS = [ drop ] [ 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 2a9819c642..8325be9a9c 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 ] [ throw-cl-error ] if ; inline + dup CL_SUCCESS = [ drop ] [ cl-error ] if ; inline : cl-not-null ( err -- ) - dup f = [ throw-cl-error ] [ drop ] if ; inline + dup f = [ 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 throw-cl-error f ] } + clReleaseProgram cl-success 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 a4e0b15b9b..13814015a8 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 ] - [ [ throw-no-pair-method ] curry suffix ] bi 1quotation + [ [ 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 4835248cc6..201b91e5e7 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 - [ throw-cannot-delete-key ] [ + [ cannot-delete-key ] [ [ delete-at ] [ 2drop ] if-hash ] if-key ; inline diff --git a/extra/pcre/pcre.factor b/extra/pcre/pcre.factor index cad0bd4875..e17eeaa71e 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 ] [ throw-bad-option ] if ; + rot 0 = [ drop ] [ 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 ] [ throw-malformed-regexp ] if* ; + dup (pcre) 2array swap [ 2nip ] [ 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 throw-pcre-error + PCRE_ERRORS number>enum pcre-error ] [ -1 = [ 2drop dup exec-opts>> 0 = diff --git a/extra/poker/poker.factor b/extra/poker/poker.factor index 9979a3be5e..50d0feebd1 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 ] [ throw-no-card ] if* ; + 2dup index [ swap remove-nth! drop ] [ 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 [ throw-bad-suit-symbol ] unless ; + } ?at [ 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 4d856b82c0..b397a0b287 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? [ throw-invalid-percent ] unless ; + dup 0 1 between? [ invalid-percent ] unless ; ERROR: invalid-length x ; : check-length ( x -- x ) - dup { [ 0 > ] [ integer? ] } 1&& [ throw-invalid-length ] unless ; + dup { [ 0 > ] [ integer? ] } 1&& [ 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 0121bf8cf1..5b4f0b3283 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 -- * ) - throw-redis-error ; + redis-error ; PRIVATE> diff --git a/extra/resolv-conf/resolv-conf.factor b/extra/resolv-conf/resolv-conf.factor index 8fe2473a4a..b6eefd2147 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? ] } - [ throw-unsupported-resolv.conf-option ] + [ 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 ] } - [ throw-unsupported-resolv.conf-line ] + [ unsupported-resolv.conf-line ] } cond ; PRIVATE> diff --git a/extra/roles/roles.factor b/extra/roles/roles.factor index c6c74bbd46..e32503e76b 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 ] [ throw-role-slot-overlap ] if ; + duplicates dup empty? [ 2drop ] [ 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 throw-multiple-inheritance-attempted ] + [ drop 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 142904e008..0790cde7d9 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 [ throw-no-class ] unless ; + classes get ?at [ 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 42ffccb400..3a7d29e6da 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 throw-bad-identifier ] + [ drop bad-identifier ] } 2|| ; : local-writer ( name lexenv -- local ) @@ -63,5 +63,5 @@ M: bad-identifier summary drop "Unknown identifier" ; { [ local-writer ] [ ivar-writer ] - [ drop throw-bad-identifier ] + [ drop bad-identifier ] } 2|| ; diff --git a/extra/smalltalk/parser/parser.factor b/extra/smalltalk/parser/parser.factor index ae58d6c0b9..6de20afc6d 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 [ ] [ throw-bad-number ] ?if ; + >string dup string>number [ ] [ bad-number ] ?if ; EBNF: parse-smalltalk diff --git a/extra/tar/tar.factor b/extra/tar/tar.factor index c8f2c3212a..1417c07eed 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 = [ throw-checksum-error ] unless + ] dip = [ 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 181a891ea2..4541a15eca 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 [ throw-fica-base-unknown ] unless* ; + } at [ 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 4093e41e93..3372a07e82 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 = [ throw-bad-magic ] unless ; + MAGIC = [ 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 02a81ee96c..998353eab4 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= [ throw-bad-magic ] unless ; + 4 read "TZif" sequence= [ 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 51ada98c93..6bc2242074 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? - [ throw-dimensions-not-equal ] unless ; + [ 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 d1020037d9..111ea99159 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 - [ ] [ throw-no-such-state ] ?if ; + [ ] [ 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 f30b3da56b..c1d23e0d9a 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 > [ throw-bad-length ] when ; inline + dup length 45 > [ 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|| - [ throw-illegal-character ] when ; + [ illegal-character ] when ; :: ascii>binary ( seq -- seq' ) 0 :> char! diff --git a/extra/vocabs/git/git.factor b/extra/vocabs/git/git.factor index 1792fdc3cb..8e1c30fae3 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 ] - [ throw-git-revision-not-found ] if* ; + [ 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 09d2908c77..058ead1e53 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 throw-libyaml-parser-error ; + } cleave [ clone ] 7 napply libyaml-parser-error ; : (libyaml-emitter-error) ( emitter -- ) - [ error>> ] [ problem>> ] bi [ clone ] bi@ throw-libyaml-emitter-error ; + [ error>> ] [ problem>> ] bi [ clone ] bi@ 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 ] [ throw-yaml-undefined-anchor ] if ; + [ 2drop ] [ 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 throw-yaml-unexpected-event ] if + [ 2drop ] [ 1array 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 } throw-yaml-unexpected-event ] + [ { YAML_DOCUMENT_START_EVENT YAML_STREAM_END_EVENT } 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 [ throw-yaml-no-document ] unless ] 2bi + [ ?parse-yaml-doc [ yaml-no-document ] unless ] 2bi ] with-destructors ; : yaml-docs> ( str -- arr ) diff --git a/extra/zeromq/zeromq.factor b/extra/zeromq/zeromq.factor index b92e95f85a..04c2299d09 100644 --- a/extra/zeromq/zeromq.factor +++ b/extra/zeromq/zeromq.factor @@ -13,7 +13,7 @@ TUPLE: zmq-error n string ; zmq_errno dup zmq_strerror zmq-error boa throw ; inline : check-zmq-error ( retval -- ) - [ throw-zmq-error ] unless-zero ; inline + [ zmq-error ] unless-zero ; inline : zmq-version ( -- version ) { int int int } [ zmq_version ] with-out-parameters 3array ; @@ -62,7 +62,7 @@ TUPLE: zmq-socket underlying ; : ( context type -- socket ) [ underlying>> ] dip zmq_socket - dup [ throw-zmq-error ] unless + dup [ zmq-error ] unless zmq-socket boa ; M: zmq-socket dispose @@ -90,11 +90,11 @@ M: zmq-socket zmq-setopt : zmq-sendmsg ( socket msg flags -- ) [ [ underlying>> ] bi@ ] dip zmq_sendmsg - 0 < [ throw-zmq-error ] when ; + 0 < [ zmq-error ] when ; : zmq-recvmsg ( socket msg flags -- ) [ [ underlying>> ] bi@ ] dip zmq_recvmsg - 0 < [ throw-zmq-error ] when ; + 0 < [ zmq-error ] when ; : zmq-send ( socket byte-array flags -- ) [ byte-array>zmq-message ] dip diff --git a/extra/zoneinfo/zoneinfo.factor b/extra/zoneinfo/zoneinfo.factor index 7c1b472e42..19368e32ab 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 [ throw-zone-not-found ] unless ; + [ last ] assoc-map ?at [ zone-not-found ] unless ; : find-zone-rules ( string -- zone rules ) find-zone dup rules/save>> find-rules ; -- 2.34.1