From 6417f36397df86d03477dfa46f53b111a71f9107 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Thu, 13 Oct 2011 17:21:59 -0700 Subject: [PATCH] namespaces: adding a "with-global" word to replace "global [ ] bind". --- basis/bootstrap/image/image.factor | 2 +- basis/command-line/command-line.factor | 4 ++-- basis/compiler/compiler.factor | 2 +- basis/debugger/debugger.factor | 4 ++-- basis/debugger/threads/threads.factor | 4 ++-- basis/http/server/server.factor | 2 +- basis/smtp/server/server.factor | 4 ++-- basis/ui/gestures/gestures.factor | 4 ++-- core/namespaces/namespaces.factor | 7 ++++--- extra/curses/listener/listener.factor | 2 +- extra/pop3/server/server.factor | 2 +- 11 files changed, 19 insertions(+), 18 deletions(-) diff --git a/basis/bootstrap/image/image.factor b/basis/bootstrap/image/image.factor index 650bbd8103..f7b95657d4 100755 --- a/basis/bootstrap/image/image.factor +++ b/basis/bootstrap/image/image.factor @@ -330,7 +330,7 @@ M: f ' drop \ f type-number ; ! Words : word-sub-primitive ( word -- obj ) - global [ target-word ] bind sub-primitives get at ; + [ target-word ] with-global sub-primitives get at ; : emit-word ( word -- ) [ diff --git a/basis/command-line/command-line.factor b/basis/command-line/command-line.factor index 4bc899b2f1..fc924b5c2e 100644 --- a/basis/command-line/command-line.factor +++ b/basis/command-line/command-line.factor @@ -62,10 +62,10 @@ SYMBOL: main-vocab-hook ] if ; : default-cli-args ( -- ) - global [ + [ "e" off "user-init" on main-vocab "run" set - ] bind ; + ] with-global ; [ default-cli-args ] "command-line" add-startup-hook diff --git a/basis/compiler/compiler.factor b/basis/compiler/compiler.factor index 0aae136cae..6b10b8cfa4 100644 --- a/basis/compiler/compiler.factor +++ b/basis/compiler/compiler.factor @@ -33,7 +33,7 @@ SYMBOL: compiled } 1|| not ; : compiler-message ( string -- ) - "trace-compilation" get [ global [ print flush ] bind ] [ drop ] if ; + "trace-compilation" get [ [ print flush ] with-global ] [ drop ] if ; : start ( word -- ) dup name>> compiler-message diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor index 0ac1078e93..9e800140c1 100755 --- a/basis/debugger/debugger.factor +++ b/basis/debugger/debugger.factor @@ -10,7 +10,7 @@ classes compiler.units generic.standard generic.single vocabs init kernel.private io.encodings accessors math.order destructors source-files parser classes.tuple.parser effects.parser lexer generic.parser strings.parser vocabs.loader -vocabs.parser source-files.errors ; +vocabs.parser source-files.errors namespaces ; IN: debugger GENERIC: error-help ( error -- topic ) @@ -65,7 +65,7 @@ M: string error. print ; : print-error ( error -- ) [ error. flush ] curry - [ global [ "Error in print-error!" print drop ] bind ] + [ [ "Error in print-error!" print drop ] with-global ] recover ; : :error ( -- ) diff --git a/basis/debugger/threads/threads.factor b/basis/debugger/threads/threads.factor index f487c5e013..3f5a074b25 100644 --- a/basis/debugger/threads/threads.factor +++ b/basis/debugger/threads/threads.factor @@ -15,12 +15,12 @@ IN: debugger.threads ! ( error thread -- ) [ dup initial-thread get-global eq? [ die ] [ - global [ + [ error-in-thread. nl print-error nl :c flush - ] bind + ] with-global stop ] if ] thread-error-hook set-global diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 44ee5f06c3..3f67ad3d83 100644 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -272,7 +272,7 @@ SYMBOL: params ] [ [ \ do-request log-error ] [ <500> ] bi ] recover ; : ?refresh-all ( -- ) - development? get-global [ global [ refresh-all ] bind ] when ; + development? get-global [ [ refresh-all ] with-global ] when ; LOG: httpd-benchmark DEBUG diff --git a/basis/smtp/server/server.factor b/basis/smtp/server/server.factor index dbff4fd214..cb4bb753e8 100644 --- a/basis/smtp/server/server.factor +++ b/basis/smtp/server/server.factor @@ -66,7 +66,7 @@ SYMBOL: data-mode "220 OK\r\n" write flush t ] } - { [ data-mode get ] [ dup global [ print ] bind t ] } + { [ data-mode get ] [ dup [ print ] with-global t ] } [ "500 ERROR\r\n" write flush t ] } cond nip [ process ] when ; @@ -80,7 +80,7 @@ SYMBOL: data-mode 1 minutes timeouts "220 hello\r\n" write flush process - global [ flush ] bind + [ flush ] with-global ] with-stream ] with-disposal ] with-test-context diff --git a/basis/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor index 658e179301..c082c0764e 100644 --- a/basis/ui/gestures/gestures.factor +++ b/basis/ui/gestures/gestures.factor @@ -267,7 +267,7 @@ SYMBOL: drag-timer } 0&& nip ; : update-click# ( button -- ) - global [ + [ dup multi-click? [ hand-click# inc ] [ @@ -275,7 +275,7 @@ SYMBOL: drag-timer ] if hand-last-button set nano-count hand-last-time set - ] bind ; + ] with-global ; : update-clicked ( -- ) hand-gadget get-global hand-clicked set-global diff --git a/core/namespaces/namespaces.factor b/core/namespaces/namespaces.factor index a100c2d15f..38c6870cb8 100644 --- a/core/namespaces/namespaces.factor +++ b/core/namespaces/namespaces.factor @@ -21,11 +21,11 @@ PRIVATE> : set ( value variable -- ) namespace set-at ; : on ( variable -- ) t swap set ; inline : off ( variable -- ) f swap set ; inline -: get-global ( variable -- value ) global at ; -: set-global ( value variable -- ) global set-at ; +: get-global ( variable -- value ) global at ; inline +: set-global ( value variable -- ) global set-at ; inline : change ( variable quot -- ) [ [ get ] keep ] dip dip set ; inline : change-global ( variable quot -- ) [ global ] dip change-at ; inline -: +@ ( n variable -- ) [ 0 or + ] change ; +: +@ ( n variable -- ) [ 0 or + ] change ; inline : inc ( variable -- ) 1 swap +@ ; inline : dec ( variable -- ) -1 swap +@ ; inline : bind ( ns quot -- ) swap >n call ndrop ; inline @@ -33,4 +33,5 @@ PRIVATE> : make-assoc ( quot exemplar -- hash ) 20 swap new-assoc [ swap bind ] keep ; inline : with-scope ( quot -- ) 5 swap bind ; inline : with-variable ( value key quot -- ) [ associate ] dip bind ; inline +: with-global ( quot -- ) global swap bind ; inline : initialize ( variable quot -- ) [ unless* ] curry change-global ; inline diff --git a/extra/curses/listener/listener.factor b/extra/curses/listener/listener.factor index 4505c63cbc..6051b1ca01 100644 --- a/extra/curses/listener/listener.factor +++ b/extra/curses/listener/listener.factor @@ -59,6 +59,6 @@ INSTANCE: curses-listener-stream plain-writer ] with-curses ; : test-listener ( -- ) - global [ run-listener ] bind ; + [ run-listener ] with-global ; MAIN: run-listener diff --git a/extra/pop3/server/server.factor b/extra/pop3/server/server.factor index 775a457fc5..aefec65cd3 100644 --- a/extra/pop3/server/server.factor +++ b/extra/pop3/server/server.factor @@ -254,7 +254,7 @@ This is the body of the second test. 1 minutes timeouts "+OK POP3 server ready\r\n" write flush process - global [ flush ] bind + [ flush ] with-global ] with-stream ] with-disposal ] with-test-context