From 00077897953130c6b72052704d75350559d68399 Mon Sep 17 00:00:00 2001 From: Alexander Iljin Date: Mon, 22 Apr 2019 16:49:05 +0200 Subject: [PATCH] continuations[-docs]: add the finally word --- basis/concurrency/distributed/distributed.factor | 2 +- basis/concurrency/locks/locks.factor | 2 +- basis/concurrency/semaphores/semaphores.factor | 4 ++-- basis/db/tuples/tuples.factor | 2 +- basis/environment/environment.factor | 2 +- basis/game/input/input.factor | 2 +- basis/hash-sets/wrapped/prettyprint/prettyprint.factor | 2 +- basis/hashtables/wrapped/prettyprint/prettyprint.factor | 2 +- basis/io/directories/unix/unix.factor | 2 +- basis/io/directories/windows/windows.factor | 2 +- basis/io/files/info/windows/windows.factor | 2 +- basis/io/files/unique/unique.factor | 6 +++--- basis/io/monitors/monitors.factor | 2 +- basis/io/servers/servers.factor | 2 +- basis/listener/listener.factor | 2 +- basis/logging/server/server.factor | 2 +- basis/math/floats/env/env.factor | 6 +++--- basis/models/models.factor | 2 +- basis/opengl/framebuffers/framebuffers.factor | 4 ++-- basis/opengl/opengl.factor | 4 ++-- basis/opengl/shaders/shaders.factor | 2 +- basis/prettyprint/backend/backend.factor | 2 +- basis/stack-checker/stack-checker-tests.factor | 2 +- basis/tools/coverage/coverage.factor | 2 +- basis/tools/destructors/destructors.factor | 2 +- basis/tools/profiler/sampling/sampling.factor | 2 +- basis/ui/backend/gtk/gtk.factor | 2 +- basis/ui/backend/gtk/io/io.factor | 2 +- basis/ui/backend/windows/windows.factor | 2 +- basis/ui/ui.factor | 2 +- basis/unix/groups/groups.factor | 4 ++-- basis/unix/signals/signals-tests.factor | 2 +- basis/unix/users/users.factor | 6 +++--- basis/unix/utmpx/utmpx.factor | 2 +- basis/vocabs/refresh/refresh-tests.factor | 2 +- basis/windows/com/com.factor | 2 +- basis/windows/privileges/privileges.factor | 4 ++-- basis/windows/registry/registry.factor | 4 ++-- basis/x11/x11.factor | 2 +- basis/x11/xim/xim.factor | 2 +- core/alien/alien.factor | 2 +- core/compiler/units/units.factor | 2 +- core/continuations/continuations-docs.factor | 6 +++++- core/continuations/continuations.factor | 3 +++ core/destructors/destructors.factor | 2 +- core/effects/parser/parser.factor | 2 +- core/io/files/files-tests.factor | 2 +- extra/compiler/cfg/gvn/testing/testing.factor | 4 ++-- extra/cuda/contexts/contexts.factor | 2 +- extra/cuda/gl/gl.factor | 2 +- extra/curses/curses.factor | 2 +- extra/graphviz/graphviz-tests.factor | 2 +- extra/graphviz/render/render.factor | 2 +- extra/managed-server/managed-server.factor | 2 +- extra/mason/build/build.factor | 2 +- extra/odbc/odbc.factor | 2 +- extra/tools/image-analyzer/utils/utils.factor | 2 +- 57 files changed, 76 insertions(+), 69 deletions(-) diff --git a/basis/concurrency/distributed/distributed.factor b/basis/concurrency/distributed/distributed.factor index 9f480362ec..7e59a4ef79 100644 --- a/basis/concurrency/distributed/distributed.factor +++ b/basis/concurrency/distributed/distributed.factor @@ -60,7 +60,7 @@ C: connection [ stream>> dispose ] [ drop ] if ; : with-connection ( remote-thread quot -- ) - '[ connect @ ] over [ disconnect ] curry [ ] cleanup ; inline + '[ connect @ ] over [ disconnect ] curry finally ; inline : send-remote-message ( message node -- ) binary [ serialize ] with-client ; diff --git a/basis/concurrency/locks/locks.factor b/basis/concurrency/locks/locks.factor index 9e56c04253..69c6c8b4f8 100644 --- a/basis/concurrency/locks/locks.factor +++ b/basis/concurrency/locks/locks.factor @@ -27,7 +27,7 @@ TUPLE: lock threads owner reentrant? ; :: do-lock ( lock timeout quot acquire release -- ) lock timeout acquire call - quot lock release curry [ ] cleanup ; inline + quot lock release curry finally ; inline : (with-lock) ( lock timeout quot -- ) [ acquire-lock ] [ release-lock ] do-lock ; inline diff --git a/basis/concurrency/semaphores/semaphores.factor b/basis/concurrency/semaphores/semaphores.factor index 392b7557d6..11196b4f49 100644 --- a/basis/concurrency/semaphores/semaphores.factor +++ b/basis/concurrency/semaphores/semaphores.factor @@ -32,7 +32,7 @@ M: negative-count-semaphore summary :: with-semaphore-timeout ( semaphore timeout quot -- ) semaphore timeout acquire-timeout - quot [ semaphore release ] [ ] cleanup ; inline + quot [ semaphore release ] finally ; inline : with-semaphore ( semaphore quot -- ) - swap dup acquire '[ _ release ] [ ] cleanup ; inline + swap dup acquire '[ _ release ] finally ; inline diff --git a/basis/db/tuples/tuples.factor b/basis/db/tuples/tuples.factor index e4422eea89..bb8000828b 100644 --- a/basis/db/tuples/tuples.factor +++ b/basis/db/tuples/tuples.factor @@ -48,7 +48,7 @@ GENERIC: eval-generator ( singleton -- object ) : with-disposals ( object quotation -- ) over sequence? [ - over '[ _ dispose-each ] [ ] cleanup + over '[ _ dispose-each ] finally ] [ with-disposal ] if ; inline diff --git a/basis/environment/environment.factor b/basis/environment/environment.factor index 79c83733a3..f945d2933c 100644 --- a/basis/environment/environment.factor +++ b/basis/environment/environment.factor @@ -27,7 +27,7 @@ HOOK: set-os-envs-pointer os ( malloc -- ) : with-os-env ( value key quot -- ) over [ [ [ set-os-env ] 2curry ] [ compose ] bi* ] dip - [ os-env ] keep [ set-os-env ] 2curry [ ] cleanup ; inline + [ os-env ] keep [ set-os-env ] 2curry finally ; inline { { [ os unix? ] [ "environment.unix" require ] } diff --git a/basis/game/input/input.factor b/basis/game/input/input.factor index e46587f5ba..f36bc212e3 100644 --- a/basis/game/input/input.factor +++ b/basis/game/input/input.factor @@ -59,7 +59,7 @@ ERROR: game-input-not-open ; ] unless ; : with-game-input ( quot -- ) - open-game-input [ close-game-input ] [ ] cleanup ; inline + open-game-input [ close-game-input ] finally ; inline TUPLE: controller handle ; TUPLE: controller-state x y z rx ry rz slider pov buttons ; diff --git a/basis/hash-sets/wrapped/prettyprint/prettyprint.factor b/basis/hash-sets/wrapped/prettyprint/prettyprint.factor index 265f758580..810be0c91a 100644 --- a/basis/hash-sets/wrapped/prettyprint/prettyprint.factor +++ b/basis/hash-sets/wrapped/prettyprint/prettyprint.factor @@ -10,4 +10,4 @@ M: wrapped-hash-set >pprint-sequence members ; M: wrapped-hash-set pprint* nesting-limit inc - [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ; + [ pprint-object ] [ nesting-limit dec ] finally ; diff --git a/basis/hashtables/wrapped/prettyprint/prettyprint.factor b/basis/hashtables/wrapped/prettyprint/prettyprint.factor index 1abd5cc10a..cf4100e44d 100644 --- a/basis/hashtables/wrapped/prettyprint/prettyprint.factor +++ b/basis/hashtables/wrapped/prettyprint/prettyprint.factor @@ -10,4 +10,4 @@ M: wrapped-hashtable >pprint-sequence >alist ; M: wrapped-hashtable pprint* nesting-limit inc - [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ; + [ pprint-object ] [ nesting-limit dec ] finally ; diff --git a/basis/io/directories/unix/unix.factor b/basis/io/directories/unix/unix.factor index 14a37f5bed..2b989fe501 100644 --- a/basis/io/directories/unix/unix.factor +++ b/basis/io/directories/unix/unix.factor @@ -42,7 +42,7 @@ M: unix copy-file ( from to -- ) : with-unix-directory ( path quot -- ) dupd '[ _ _ [ opendir dup [ throw-errno ] unless ] dip - dupd curry swap '[ _ closedir io-error ] [ ] cleanup + dupd curry swap '[ _ closedir io-error ] finally ] with-directory ; inline : dirent-type>file-type ( type -- file-type ) diff --git a/basis/io/directories/windows/windows.factor b/basis/io/directories/windows/windows.factor index 93a7d6f969..ec76156775 100644 --- a/basis/io/directories/windows/windows.factor +++ b/basis/io/directories/windows/windows.factor @@ -84,4 +84,4 @@ M: windows (directory-entries) ( path -- seq ) produce nip over name>> "." = [ nip ] [ swap prefix ] if ] - ] [ drop '[ _ FindClose win32-error=0/f ] ] 2bi [ ] cleanup ; + ] [ drop '[ _ FindClose win32-error=0/f ] ] 2bi finally ; diff --git a/basis/io/files/info/windows/windows.factor b/basis/io/files/info/windows/windows.factor index 702d832454..71f8e06f69 100644 --- a/basis/io/files/info/windows/windows.factor +++ b/basis/io/files/info/windows/windows.factor @@ -194,7 +194,7 @@ CONSTANT: names-buf-length 16384 [ _ find-next-volume dup ] [ ] produce nip swap prefix ] - ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi [ ] cleanup ; + ] [ '[ _ FindVolumeClose win32-error=0/f ] ] bi finally ; ! Windows may return a volume which looks up to path "" ! For now, treat it like there is not a volume here diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index 93ad08cc7a..9a2647a52e 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -50,11 +50,11 @@ PRIVATE> :: cleanup-unique-file ( ..a prefix suffix quot: ( ..a path -- ..b ) -- ..b ) prefix suffix unique-file :> path - [ path quot call ] [ path delete-file ] [ ] cleanup ; inline + [ path quot call ] [ path delete-file ] finally ; inline :: cleanup-unique-files ( ..a prefix suffixes quot: ( ..a paths -- ..b ) -- ..b ) prefix suffixes unique-files :> paths - [ paths quot call ] [ paths [ delete-file ] each ] [ ] cleanup ; inline + [ paths quot call ] [ paths [ delete-file ] each ] finally ; inline : unique-directory ( -- path ) [ @@ -70,7 +70,7 @@ PRIVATE> :: cleanup-unique-directory ( quot -- ) unique-directory :> path [ path quot with-directory ] - [ path delete-tree ] [ ] cleanup ; inline + [ path delete-tree ] finally ; inline { { [ os unix? ] [ "io.files.unique.unix" ] } diff --git a/basis/io/monitors/monitors.factor b/basis/io/monitors/monitors.factor index c0286f594d..6891f9983f 100644 --- a/basis/io/monitors/monitors.factor +++ b/basis/io/monitors/monitors.factor @@ -16,7 +16,7 @@ M: object dispose-monitors ; : with-monitors ( quot -- ) [ init-monitors - [ dispose-monitors ] [ ] cleanup + [ dispose-monitors ] finally ] with-scope ; inline TUPLE: monitor < disposable path queue timeout ; diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor index b25cb22c11..c603d144c6 100644 --- a/basis/io/servers/servers.factor +++ b/basis/io/servers/servers.factor @@ -211,7 +211,7 @@ PRIVATE> '[ [ _ threaded-server _ with-variable ] [ _ stop-server ] - [ ] cleanup + finally ] call ; inline rfc3339) "] " write ; diff --git a/basis/math/floats/env/env.factor b/basis/math/floats/env/env.factor index df6328729e..c86f97c5f4 100644 --- a/basis/math/floats/env/env.factor +++ b/basis/math/floats/env/env.factor @@ -134,14 +134,14 @@ PRIVATE> :: with-denormal-mode ( mode quot -- ) denormal-mode :> orig mode set-denormal-mode - quot [ orig set-denormal-mode ] [ ] cleanup ; inline + quot [ orig set-denormal-mode ] finally ; inline : rounding-mode ( -- mode ) fp-env-register (get-rounding-mode) ; :: with-rounding-mode ( mode quot -- ) rounding-mode :> orig mode set-rounding-mode - quot [ orig set-rounding-mode ] [ ] cleanup ; inline + quot [ orig set-rounding-mode ] finally ; inline : fp-traps ( -- exceptions ) (fp-env-registers) [ (get-fp-traps) ] [ union ] map-reduce >array ; inline @@ -150,7 +150,7 @@ PRIVATE> clear-fp-exception-flags fp-traps :> orig exceptions set-fp-traps - quot [ orig set-fp-traps ] [ ] cleanup ; inline + quot [ orig set-fp-traps ] finally ; inline : without-fp-traps ( quot -- ) { } swap with-fp-traps ; inline diff --git a/basis/models/models.factor b/basis/models/models.factor index 6d3a9a9e83..0fa5f2079e 100644 --- a/basis/models/models.factor +++ b/basis/models/models.factor @@ -68,7 +68,7 @@ GENERIC: model-changed ( model observer -- ) : with-locked-model ( model quot -- ) [ '[ _ t >>locked? @ ] ] [ drop '[ f _ locked?<< ] ] - 2bi [ ] cleanup ; inline + 2bi finally ; inline GENERIC: update-model ( model -- ) diff --git a/basis/opengl/framebuffers/framebuffers.factor b/basis/opengl/framebuffers/framebuffers.factor index 3eb3705d0c..18027e18c3 100644 --- a/basis/opengl/framebuffers/framebuffers.factor +++ b/basis/opengl/framebuffers/framebuffers.factor @@ -37,7 +37,7 @@ IN: opengl.framebuffers : with-framebuffer ( id quot -- ) [ GL_DRAW_FRAMEBUFFER swap glBindFramebuffer ] dip - [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer ] [ ] cleanup ; inline + [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer ] finally ; inline : with-draw-read-framebuffers ( draw-id read-id quot -- ) [ @@ -47,7 +47,7 @@ IN: opengl.framebuffers [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer GL_READ_FRAMEBUFFER 0 glBindFramebuffer - ] [ ] cleanup ; inline + ] finally ; inline : framebuffer-attachment ( attachment -- id ) GL_FRAMEBUFFER swap GL_FRAMEBUFFER_ATTACHMENT_OBJECT_NAME diff --git a/basis/opengl/opengl.factor b/basis/opengl/opengl.factor index 53887994d4..b261d59c58 100644 --- a/basis/opengl/opengl.factor +++ b/basis/opengl/opengl.factor @@ -174,7 +174,7 @@ MACRO: all-enabled-client-state ( seq quot -- quot ) :: with-gl-buffer ( binding id quot -- ) binding id glBindBuffer - quot [ binding 0 glBindBuffer ] [ ] cleanup ; inline + quot [ binding 0 glBindBuffer ] finally ; inline : with-array-element-buffers ( array-buffer element-buffer quot -- ) [ GL_ELEMENT_ARRAY_BUFFER ] 2dip '[ @@ -189,7 +189,7 @@ MACRO: all-enabled-client-state ( seq quot -- quot ) :: with-vertex-array ( id quot -- ) id glBindVertexArray - quot [ 0 glBindVertexArray ] [ ] cleanup ; inline + quot [ 0 glBindVertexArray ] finally ; inline : ( target data hint -- id ) pick gen-gl-buffer [ diff --git a/basis/opengl/shaders/shaders.factor b/basis/opengl/shaders/shaders.factor index a4a21880e7..22086b986d 100644 --- a/basis/opengl/shaders/shaders.factor +++ b/basis/opengl/shaders/shaders.factor @@ -114,7 +114,7 @@ PREDICATE: fragment-shader < gl-shader (fragment-shader?) ; ] each glDeleteProgram ; : with-gl-program ( program quot -- ) - over glUseProgram [ 0 glUseProgram ] [ ] cleanup ; inline + over glUseProgram [ 0 glUseProgram ] finally ; inline PREDICATE: gl-program < integer (gl-program?) ; diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor index 0fd99e7e0b..e2f58de6e2 100644 --- a/basis/prettyprint/backend/backend.factor +++ b/basis/prettyprint/backend/backend.factor @@ -266,7 +266,7 @@ M: byte-vector pprint* pprint-object ; : with-extra-nesting-level ( quot -- ) nesting-limit [ dup [ 1 + ] [ f ] if* ] change - [ nesting-limit set ] curry [ ] cleanup ; inline + [ nesting-limit set ] curry finally ; inline M: hashtable pprint* [ pprint-object ] with-extra-nesting-level ; diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor index 267245daed..792d209bde 100644 --- a/basis/stack-checker/stack-checker-tests.factor +++ b/basis/stack-checker/stack-checker-tests.factor @@ -246,7 +246,7 @@ DEFER: blah4 ! Test words with continuations { 0 0 } [ [ drop ] callcc0 ] must-infer-as { 0 1 } [ [ 4 swap continue-with ] callcc1 ] must-infer-as -{ 2 1 } [ [ + ] [ ] [ ] cleanup ] must-infer-as +{ 2 1 } [ [ + ] [ ] finally ] must-infer-as { 2 1 } [ [ + ] [ 3drop 0 ] recover ] must-infer-as ! A typo diff --git a/basis/tools/coverage/coverage.factor b/basis/tools/coverage/coverage.factor index 5854deeee6..bfcabbc98c 100644 --- a/basis/tools/coverage/coverage.factor +++ b/basis/tools/coverage/coverage.factor @@ -126,7 +126,7 @@ PRIVATE> _ [ coverage-on test-vocab coverage-off ] [ coverage ] bi - ] [ _ remove-coverage ] [ ] cleanup + ] [ _ remove-coverage ] finally ] call ] bi ; diff --git a/basis/tools/destructors/destructors.factor b/basis/tools/destructors/destructors.factor index 36cecc35e8..452cb29fd2 100644 --- a/basis/tools/destructors/destructors.factor +++ b/basis/tools/destructors/destructors.factor @@ -47,7 +47,7 @@ PRIVATE> t debug-leaks? set-global [ [ call disposables get clone ] dip - ] [ f debug-leaks? set-global ] [ ] cleanup + ] [ f debug-leaks? set-global ] finally diff ; inline : leaks. ( quot -- ) diff --git a/basis/tools/profiler/sampling/sampling.factor b/basis/tools/profiler/sampling/sampling.factor index b6aa596823..c0ba754fe9 100644 --- a/basis/tools/profiler/sampling/sampling.factor +++ b/basis/tools/profiler/sampling/sampling.factor @@ -30,7 +30,7 @@ PRIVATE> : profile ( quot -- ) samples-per-second get-global profiling [ 0 profiling (get-samples) raw-profile-data set-global ] - [ ] cleanup ; inline + finally ; inline : total-sample-count ( sample -- count ) 0 swap nth ; : gc-sample-count ( sample -- count ) 1 swap nth ; diff --git a/basis/ui/backend/gtk/gtk.factor b/basis/ui/backend/gtk/gtk.factor index fb7cee86e9..f3a78aa79b 100644 --- a/basis/ui/backend/gtk/gtk.factor +++ b/basis/ui/backend/gtk/gtk.factor @@ -80,7 +80,7 @@ M: gtk-clipboard set-clipboard-contents source G_PRIORITY_DEFAULT_IDLE g_source_set_priority source f g_source_attach drop [ quot call( -- ) ] - [ source g_source_destroy ] [ ] cleanup ; + [ source g_source_destroy ] finally ; ! User input diff --git a/basis/ui/backend/gtk/io/io.factor b/basis/ui/backend/gtk/io/io.factor index 577a05f1f4..4e661c6a91 100644 --- a/basis/ui/backend/gtk/io/io.factor +++ b/basis/ui/backend/gtk/io/io.factor @@ -48,4 +48,4 @@ CONSTANT: poll-fd-events [ source g_source_destroy start-io-thread - ] [ ] cleanup ; + ] finally ; diff --git a/basis/ui/backend/windows/windows.factor b/basis/ui/backend/windows/windows.factor index 7431ddb4c9..ab21fb7936 100644 --- a/basis/ui/backend/windows/windows.factor +++ b/basis/ui/backend/windows/windows.factor @@ -704,7 +704,7 @@ M: windows-ui-backend (with-ui) init-win32-ui start-ui event-loop - ] [ cleanup-win32-ui ] [ ] cleanup ; + ] [ cleanup-win32-ui ] finally ; M: windows-ui-backend beep 0 MessageBeep drop ; diff --git a/basis/ui/ui.factor b/basis/ui/ui.factor index 43af6f6c81..347def51fe 100644 --- a/basis/ui/ui.factor +++ b/basis/ui/ui.factor @@ -228,7 +228,7 @@ M: object resize-window 2drop ; f ui-running set-global ! Give running ui threads a chance to finish. notify-ui-thread yield - ] [ ] cleanup + ] finally ] if ; HOOK: beep ui-backend ( -- ) diff --git a/basis/unix/groups/groups.factor b/basis/unix/groups/groups.factor index b43f8d43ac..92cf9f258f 100644 --- a/basis/unix/groups/groups.factor +++ b/basis/unix/groups/groups.factor @@ -115,14 +115,14 @@ GENERIC: set-effective-group ( obj -- ) : (with-real-group) ( string/id quot -- ) '[ _ set-real-group @ ] - real-group-id '[ _ set-real-group ] [ ] cleanup ; inline + real-group-id '[ _ set-real-group ] finally ; inline : with-real-group ( string/id/f quot -- ) over [ (with-real-group) ] [ nip call ] if ; inline : (with-effective-group) ( string/id quot -- ) '[ _ set-effective-group @ ] - effective-group-id '[ _ set-effective-group ] [ ] cleanup ; inline + effective-group-id '[ _ set-effective-group ] finally ; inline : with-effective-group ( string/id/f quot -- ) over [ (with-effective-group) ] [ nip call ] if ; inline diff --git a/basis/unix/signals/signals-tests.factor b/basis/unix/signals/signals-tests.factor index 43de224cfd..f09f6dee18 100644 --- a/basis/unix/signals/signals-tests.factor +++ b/basis/unix/signals/signals-tests.factor @@ -23,7 +23,7 @@ test-sigusr1-handler SIGUSR1 add-signal-handler swap - ] unit-test -] [ test-sigusr1-handler SIGUSR1 remove-signal-handler ] [ ] cleanup +] [ test-sigusr1-handler SIGUSR1 remove-signal-handler ] finally { 0 } [ sigusr1-count get-global diff --git a/basis/unix/users/users.factor b/basis/unix/users/users.factor index ee2e592c1f..7b77eebefe 100644 --- a/basis/unix/users/users.factor +++ b/basis/unix/users/users.factor @@ -32,7 +32,7 @@ M: unix passwd>new-passwd ( passwd -- seq ) : with-pwent ( quot -- ) setpwent - [ unix.ffi:endpwent ] [ ] cleanup ; inline + [ unix.ffi:endpwent ] finally ; inline PRIVATE> @@ -94,7 +94,7 @@ GENERIC: set-effective-user ( string/id -- ) : (with-real-user) ( string/id quot -- ) '[ _ set-real-user @ ] real-user-id '[ _ set-real-user ] - [ ] cleanup ; inline + finally ; inline : with-real-user ( string/id/f quot -- ) over [ (with-real-user) ] [ nip call ] if ; inline @@ -102,7 +102,7 @@ GENERIC: set-effective-user ( string/id -- ) : (with-effective-user) ( string/id quot -- ) '[ _ set-effective-user @ ] effective-user-id '[ _ set-effective-user ] - [ ] cleanup ; inline + finally ; inline : with-effective-user ( string/id/f quot -- ) over [ (with-effective-user) ] [ nip call ] if ; inline diff --git a/basis/unix/utmpx/utmpx.factor b/basis/unix/utmpx/utmpx.factor index 6e78f12671..c61f88d8c7 100644 --- a/basis/unix/utmpx/utmpx.factor +++ b/basis/unix/utmpx/utmpx.factor @@ -38,7 +38,7 @@ M: unix new-utmpx-record utmpx-record new ; : with-utmpx ( quot -- ) - setutxent [ endutxent ] [ ] cleanup ; inline + setutxent [ endutxent ] finally ; inline : all-utmpx ( -- seq ) [ diff --git a/basis/vocabs/refresh/refresh-tests.factor b/basis/vocabs/refresh/refresh-tests.factor index 61363aa2d7..03ae27bf3d 100644 --- a/basis/vocabs/refresh/refresh-tests.factor +++ b/basis/vocabs/refresh/refresh-tests.factor @@ -4,5 +4,5 @@ USING: vocabs.refresh tools.test continuations namespaces ; changed-vocabs get-global f changed-vocabs set-global { t } [ "kernel" changed-vocab? ] unit-test - [ "kernel" changed-vocab ] [ changed-vocabs set-global ] [ ] cleanup + [ "kernel" changed-vocab ] [ changed-vocabs set-global ] finally ] unit-test diff --git a/basis/windows/com/com.factor b/basis/windows/com/com.factor index 4334eda29d..a4b759adf8 100644 --- a/basis/windows/com/com.factor +++ b/basis/windows/com/com.factor @@ -111,6 +111,6 @@ ERROR: null-com-release ; [ IUnknown::Release drop ] [ null-com-release ] if* ; inline : with-com-interface ( interface quot -- ) - over [ com-release ] curry [ ] cleanup ; inline + over [ com-release ] curry finally ; inline DESTRUCTOR: com-release diff --git a/basis/windows/privileges/privileges.factor b/basis/windows/privileges/privileges.factor index e04dfa016a..1d124fcbfa 100644 --- a/basis/windows/privileges/privileges.factor +++ b/basis/windows/privileges/privileges.factor @@ -25,7 +25,7 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES ! quot: ( token-handle -- token-handle ) [ open-process-token ] dip [ keep ] curry - [ CloseHandle drop ] [ ] cleanup ; inline + [ CloseHandle drop ] finally ; inline : lookup-privilege ( string -- luid ) [ f ] dip LUID @@ -52,4 +52,4 @@ TYPEDEF: TOKEN_PRIVILEGES* PTOKEN_PRIVILEGES : with-privileges ( seq quot -- ) [ '[ _ [ t set-privilege ] each @ ] ] [ drop '[ _ [ f set-privilege ] each ] ] - 2bi [ ] cleanup ; inline + 2bi finally ; inline diff --git a/basis/windows/registry/registry.factor b/basis/windows/registry/registry.factor index 03d2228abf..be91098276 100644 --- a/basis/windows/registry/registry.factor +++ b/basis/windows/registry/registry.factor @@ -55,13 +55,13 @@ CONSTANT: registry-value-max-length 16384 key subkey mode open-key :> hkey [ hkey quot call ] [ hkey close-key ] - [ ] cleanup ; inline + finally ; inline :: with-create-registry-key ( key subkey quot -- ) key subkey create-key :> hkey [ hkey quot call ] [ hkey close-key ] - [ ] cleanup ; inline + finally ; inline [ callbacks get delete-values ] [ free-callback ] bi ; : with-callback ( alien quot -- ) - over [ unregister-and-free-callback ] curry [ ] cleanup ; inline + over [ unregister-and-free-callback ] curry finally ; inline : initialize-alien ( symbol quot -- ) swap dup get-global dup recompute-value? diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index dbcea5bf41..a458ff6fbb 100644 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -198,7 +198,7 @@ PRIVATE> [ remove-nesting-observer finish-compilation-unit - ] [ ] cleanup + ] finally ] with-variables ; inline : with-compilation-unit ( quot -- ) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index b54f6ff6c7..7c5fcaa072 100644 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -169,12 +169,16 @@ HELP: throw { $values { "error" object } } { $description "Saves the current continuation in the " { $link error-continuation } " global variable and throws an error. Execution does not continue at the point after the " { $link throw } " call. Rather, the innermost catch block is invoked, and execution continues at that point." } ; -{ cleanup recover } related-words +{ cleanup recover finally } related-words HELP: cleanup { $values { "try" { $quotation ( ..a -- ..a ) } } { "cleanup-always" { $quotation ( ..a -- ..b ) } } { "cleanup-error" { $quotation ( ..b -- ..b ) } } } { $description "Calls the " { $snippet "try" } " quotation. If no error is thrown, calls " { $snippet "cleanup-always" } " without restoring the data stack. If an error is thrown, restores the data stack, calls " { $snippet "cleanup-always" } " followed by " { $snippet "cleanup-error" } ", and rethrows the error." } ; +HELP: finally +{ $values { "try" { $quotation ( ..a -- ..a ) } } { "cleanup-always" { $quotation ( ..a -- ..b ) } } } +{ $description "Same as " { $link cleanup } ", but with empty " { $snippet "cleanup-error" } " quotation. Useful when some cleanup code needs to be run after the " { $snippet "try" } " quotation whether an error was thrown or not, but when nothing specific needs to be done about any errors." } ; + HELP: recover { $values { "try" { $quotation ( ..a -- ..b ) } } { "recovery" { $quotation ( ..a error -- ..b ) } } } { $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the data stack and calls the " { $snippet "recovery" } " quotation to handle the error." } ; diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index 63a704a07f..bf32960d0f 100644 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -162,6 +162,9 @@ callback-error-hook [ [ die rethrow ] ] initialize : cleanup ( try cleanup-always cleanup-error -- ) [ compose [ dip rethrow ] curry recover ] [ drop ] 2bi call ; inline +: finally ( try cleanup-always -- ) + [ ] cleanup ; inline + ERROR: attempt-all-error ; : attempt-all ( ... seq quot: ( ... elt -- ... obj ) -- ... obj ) diff --git a/core/destructors/destructors.factor b/core/destructors/destructors.factor index 9571d0fb1b..c50435fed1 100644 --- a/core/destructors/destructors.factor +++ b/core/destructors/destructors.factor @@ -59,7 +59,7 @@ M: disposable dispose [ last rethrow ] unless-empty ; : with-disposal ( object quot -- ) - over [ dispose ] curry [ ] cleanup ; inline + over [ dispose ] curry finally ; inline > t or in-definition delete ; : with-definition ( quot -- ) - [ set-in-definition ] prepose [ unset-in-definition ] [ ] cleanup ; inline + [ set-in-definition ] prepose [ unset-in-definition ] finally ; inline : (:) ( -- word def effect ) [ diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 4024e5ed5c..6893424f17 100644 --- a/core/io/files/files-tests.factor +++ b/core/io/files/files-tests.factor @@ -274,7 +274,7 @@ CONSTANT: pt-array-1 [ "resource:core" normalize-path [ cwd = ] [ cd ] [ cwd = ] tri - ] cwd '[ _ dup cd cwd = ] [ ] cleanup + ] cwd '[ _ dup cd cwd = ] finally ] unit-test { t } [ diff --git a/extra/compiler/cfg/gvn/testing/testing.factor b/extra/compiler/cfg/gvn/testing/testing.factor index 73e7fe060a..3d0f68fc7a 100644 --- a/extra/compiler/cfg/gvn/testing/testing.factor +++ b/extra/compiler/cfg/gvn/testing/testing.factor @@ -93,14 +93,14 @@ SYMBOL: iteration ] with-variable ; : watch-gvn ( path quot -- ) - annotate-gvn [ test-gvn ] [ reset-gvn ] [ ] cleanup ; + annotate-gvn [ test-gvn ] [ reset-gvn ] finally ; : watch-gvn-cfg ( path cfg -- ) annotate-gvn [ { value-numbering } passes [ 0 iteration [ watch-cfg ] with-variable ] with-variable - ] [ reset-gvn ] [ ] cleanup ; + ] [ reset-gvn ] finally ; : watch-gvn-bb ( path insns -- ) 0 test-bb 0 get block>cfg watch-gvn-cfg ; diff --git a/extra/cuda/contexts/contexts.factor b/extra/cuda/contexts/contexts.factor index 175a35143c..b3cab931cb 100644 --- a/extra/cuda/contexts/contexts.factor +++ b/extra/cuda/contexts/contexts.factor @@ -28,7 +28,7 @@ DESTRUCTOR: destroy-context DESTRUCTOR: clean-up-context : (with-cuda-context) ( context quot -- ) - swap '[ _ clean-up-context ] [ ] cleanup ; inline + swap '[ _ clean-up-context ] finally ; inline : with-cuda-context ( device flags quot -- ) [ set-up-cuda-context create-context ] dip (with-cuda-context) ; inline diff --git a/extra/cuda/gl/gl.factor b/extra/cuda/gl/gl.factor index a4257c2dbb..9b71d7dec4 100644 --- a/extra/cuda/gl/gl.factor +++ b/extra/cuda/gl/gl.factor @@ -39,7 +39,7 @@ DESTRUCTOR: unmap-resource DESTRUCTOR: free-resource : with-mapped-resource ( ..a resource quot: ( ..a device-ptr size -- ..b ) -- ..b ) - over [ map-resource ] 2dip '[ _ unmap-resource ] [ ] cleanup ; inline + over [ map-resource ] 2dip '[ _ unmap-resource ] finally ; inline TUPLE: cuda-buffer { buffer buffer } diff --git a/extra/curses/curses.factor b/extra/curses/curses.factor index a6629650ad..3e4eb3e1fd 100644 --- a/extra/curses/curses.factor +++ b/extra/curses/curses.factor @@ -277,7 +277,7 @@ PRIVATE> init-colors _ with-window - ] [ ffi:endwin curses-error ] [ ] cleanup + ] [ ffi:endwin curses-error ] finally ] with-destructors ; inline graph dot-file ?encoding write-dot dot-file format layout try-graphviz-command ] - [ dot-file ?delete-file ] [ ] cleanup ; + [ dot-file ?delete-file ] finally ; : graphviz* ( graph path format -- ) default-layout get-global graphviz ; diff --git a/extra/managed-server/managed-server.factor b/extra/managed-server/managed-server.factor index e60a5b24fd..a8070abbbf 100644 --- a/extra/managed-server/managed-server.factor +++ b/extra/managed-server/managed-server.factor @@ -95,7 +95,7 @@ M: managed-server handle-client* managed-server namespaces:set [ handle-managed-client ] [ cleanup-client ] - [ ] cleanup ; + finally ; : new-managed-server ( port name encoding class -- server ) new-threaded-server diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 567075498b..217d226269 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -48,7 +48,7 @@ IN: mason.build ] bi notify-finish finish-build - ] [ cleanup-build ] [ ] cleanup + ] [ cleanup-build ] finally notify-idle ; MAIN: do-build diff --git a/extra/odbc/odbc.factor b/extra/odbc/odbc.factor index 935d9e0bae..f7bfa4d87c 100644 --- a/extra/odbc/odbc.factor +++ b/extra/odbc/odbc.factor @@ -279,4 +279,4 @@ C: field dup odbc-get-all-rows swap odbc-free-statement ] keep - ] [ odbc-disconnect ] [ ] cleanup ; + ] [ odbc-disconnect ] finally ; diff --git a/extra/tools/image-analyzer/utils/utils.factor b/extra/tools/image-analyzer/utils/utils.factor index 981a7e4658..5bfca098c4 100644 --- a/extra/tools/image-analyzer/utils/utils.factor +++ b/extra/tools/image-analyzer/utils/utils.factor @@ -29,7 +29,7 @@ IN: tools.image-analyzer.utils ] ; inline : save-io-excursion ( quot -- ) - tell-input '[ _ seek-absolute seek-input ] [ ] cleanup ; inline + tell-input '[ _ seek-absolute seek-input ] finally ; inline : consume-stream>sequence ( reader-quot: ( -- item ) -- seq ) until-eof-reader '[ drop @ ] t swap follow rest ; inline -- 2.34.1