Merge branch 'master' of git://factorcode.org/git/factor

2008-09-02 17:02:32 -05:00 · 2008-09-02 17:02:32 -05:00 · 21b74d4abf
parent 1ef49b1a00 dbd16b4978
commit 21b74d4abf
70 changed files with 191 additions and 166 deletions
--- a/basis/calendar/calendar-tests.factor
+++ b/basis/calendar/calendar-tests.factor
@ -33,8 +33,8 @@ IN: calendar.tests

 [ t ] [ 2006 10 10 0 0 0 instant <timestamp> 10 minutes time+
        2006 10 10 0 10 0 instant <timestamp> = ] unit-test
-[ t ] [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
-        2006 10 10 0 10 30 instant <timestamp> = ] unit-test
+[ +eq+ ] [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
+        2006 10 10 0 10 30 instant <timestamp> <=> ] unit-test
 [ t ] [ 2006 10 10 0 0 0 instant <timestamp> 3/4 minutes time+
        2006 10 10 0 0 45 instant <timestamp> = ] unit-test
 [ t ] [ 2006 10 10 0 0 0 instant <timestamp> -3/4 minutes time+
--- a/basis/calendar/calendar.factor
+++ b/basis/calendar/calendar.factor
@ -278,12 +278,10 @@ GENERIC: time- ( time1 time2 -- time3 )
 M: timestamp <=> ( ts1 ts2 -- n )
    [ >gmt tuple-slots ] compare ;

-<PRIVATE
 : (time-) ( timestamp timestamp -- n )
    [ >gmt ] bi@
    [ [ >date< julian-day-number ] bi@ - 86400 * ] 2keep
    [ >time< >r >r 3600 * r> 60 * r> + + ] bi@ - + ;
-PRIVATE>

 M: timestamp time-
    #! Exact calendar-time difference
--- a/basis/calendar/format/format-tests.factor
+++ b/basis/calendar/format/format-tests.factor
@ -58,7 +58,7 @@ IN: calendar.format.tests
        26
        0
        37
-        42.12345
+        42+2469/20000
        T{ duration f 0 0 0 -5 0 0 }
    }
 ] [ "2008-05-26T00:37:42.12345-05:00" rfc3339>timestamp ] unit-test
--- a/basis/channels/remote/remote.factor
+++ b/basis/channels/remote/remote.factor
@ -4,7 +4,7 @@
 ! Remote Channels
 USING: kernel init namespaces assocs arrays random
 sequences channels match concurrency.messaging
-concurrency.distributed threads ;
+concurrency.distributed threads accessors ;
 IN: channels.remote

 <PRIVATE
@ -52,13 +52,13 @@ TUPLE: remote-channel node id ;
 C: <remote-channel> remote-channel 

 M: remote-channel to ( value remote-channel -- )
-    [ [ \ to , remote-channel-id , , ] { } make ] keep
-    remote-channel-node "remote-channels" <remote-process> 
+    [ [ \ to , id>> , , ] { } make ] keep
+    node>> "remote-channels" <remote-process> 
    send-synchronous no-channel = [ no-channel throw ] when ;

 M: remote-channel from ( remote-channel -- value )
-    [ [ \ from , remote-channel-id , ] { } make ] keep
-    remote-channel-node "remote-channels" <remote-process> 
+    [ [ \ from , id>> , ] { } make ] keep
+    node>> "remote-channels" <remote-process> 
    send-synchronous dup no-channel = [ no-channel throw ] when* ;

 [
--- a/basis/cocoa/cocoa-tests.factor
+++ b/basis/cocoa/cocoa-tests.factor
@ -41,7 +41,7 @@ Bar [
    -> release
 ] compile-call

-[ 1 ] [ "x" get NSRect-x ] unit-test
-[ 2 ] [ "x" get NSRect-y ] unit-test
-[ 101 ] [ "x" get NSRect-w ] unit-test
-[ 102 ] [ "x" get NSRect-h ] unit-test
+[ 1.0 ] [ "x" get NSRect-x ] unit-test
+[ 2.0 ] [ "x" get NSRect-y ] unit-test
+[ 101.0 ] [ "x" get NSRect-w ] unit-test
+[ 102.0 ] [ "x" get NSRect-h ] unit-test
--- a/basis/compiler/compiler-docs.factor
+++ b/basis/compiler/compiler-docs.factor
@ -27,7 +27,7 @@ ARTICLE: "compiler" "Optimizing compiler"
 "The optimizing compiler only compiles words which have a static stack effect. This means that methods defined on fundamental generic words such as " { $link nth } " should have a static stack effect; for otherwise, most of the system would be compiled with the non-optimizing compiler. See " { $link "inference" } " and " { $link "cookbook-pitfalls" } "."
 { $subsection "compiler-usage" }
 { $subsection "compiler-errors" }
-{ $subsection "optimizer" }
+{ $subsection "hints" }
 { $subsection "generator" } ;

 ABOUT: "compiler"
--- a/basis/concurrency/distributed/distributed.factor
+++ b/basis/concurrency/distributed/distributed.factor
@ -37,7 +37,7 @@ M: remote-process send ( message thread -- )
    send-remote-message ;

 M: thread (serialize) ( obj -- )
-    thread-id local-node get-global <remote-process>
+    id>> local-node get-global <remote-process>
    (serialize) ;

 : stop-node ( node -- )
--- a/basis/float-vectors/float-vectors-tests.factor
+++ b/basis/float-vectors/float-vectors-tests.factor
@ -1,10 +1,10 @@
+USING: tools.test float-vectors vectors sequences kernel math ;
 IN: float-vectors.tests
-USING: tools.test float-vectors vectors sequences kernel ;

 [ 0 ] [ 123 <float-vector> length ] unit-test

 : do-it
-    12345 [ over push ] each ;
+    12345 [ >float over push ] each ;

 [ t ] [
    3 <float-vector> do-it
--- a/basis/help/help-docs.factor
+++ b/basis/help/help-docs.factor
@ -399,5 +399,5 @@ HELP: ABOUT:
 { $description "Defines the main documentation article for the current vocabulary." } ;

 HELP: vocab-help
-{ $values { "vocab" "a vocabulary specifier" } { "help" "a help article" } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "help" "a help article" } }
 { $description "Outputs the main help article for a vocabulary. The main help article can be set with " { $link POSTPONE: ABOUT:  } "." } ;
--- a/basis/hints/hints-docs.factor
+++ b/basis/hints/hints-docs.factor
@ -12,7 +12,6 @@ $nl
 $nl
 "Type hints are declared with a parsing word:"
 { $subsection POSTPONE: HINTS: }
-$nl
 "The specialized version of a word which will be compiled by the compiler can be inspected:"
 { $subsection specialized-def } ;

--- a/basis/io/encodings/ascii/ascii-docs.factor
+++ b/basis/io/encodings/ascii/ascii-docs.factor
@ -2,5 +2,10 @@ USING: help.markup help.syntax ;
 IN: io.encodings.ascii

 HELP: ascii
-{ $class-description "This is the encoding descriptor which denotes an ASCII encoding. By default, if there's a non-ASCII character in an input stream, it will be replaced with a replacement character (U+FFFD), and if a non-ASCII character is used in output, an exception is thrown." }
-{ $see-also "encodings-introduction" } ;
+{ $class-description "ASCII encoding descriptor." } ;
+
+ARTICLE: "ascii" "ASCII encoding"
+"By default, if there's a non-ASCII character in an input stream, it will be replaced with a replacement character (U+FFFD), and if a non-ASCII character is used in output, an exception is thrown."
+{ $subsection ascii } ;
+
+ABOUT: "ascii"
--- a/basis/io/encodings/utf16/utf16-docs.factor
+++ b/basis/io/encodings/utf16/utf16-docs.factor
@ -1,7 +1,7 @@
 USING: help.markup help.syntax io.encodings strings ;
 IN: io.encodings.utf16

-ARTICLE: "io.encodings.utf16" "UTF-16"
+ARTICLE: "io.encodings.utf16" "UTF-16 encoding"
 "The UTF-16 encoding is a variable-width encoding. Unicode code points are encoded as 2 or 4 byte sequences. There are three encoding descriptor classes for working with UTF-16, depending on endianness or the presence of a BOM:"
 { $subsection utf16 }
 { $subsection utf16le }
--- a/basis/io/windows/launcher/launcher.factor
+++ b/basis/io/windows/launcher/launcher.factor
@ -151,13 +151,13 @@ M: windows kill-process* ( handle -- )
    swap win32-error=0/f ;

 : process-exited ( process -- )
-    dup process-handle exit-code
-    over process-handle dispose-process
+    dup handle>> exit-code
+    over handle>> dispose-process
    notify-exit ;

 M: windows wait-for-processes ( -- ? )
    processes get keys dup
-    [ process-handle PROCESS_INFORMATION-hProcess ] map
+    [ handle>> PROCESS_INFORMATION-hProcess ] map
    dup length swap >c-void*-array 0 0
    WaitForMultipleObjects
    dup HEX: ffffffff = [ win32-error ] when
--- a/basis/opengl/capabilities/capabilities.factor
+++ b/basis/opengl/capabilities/capabilities.factor
@ -5,9 +5,9 @@ continuations math.parser math arrays sets math.order ;
 IN: opengl.capabilities

 : (require-gl) ( thing require-quot make-error-quot -- )
-    >r dupd call
-    [ r> 2drop ]
-    [ r> " " make throw ]
+    -rot dupd call
+    [ 2drop ]
+    [ swap " " make throw ]
    if ; inline

 : gl-extensions ( -- seq )
--- a/basis/tuple-arrays/tuple-arrays-tests.factor
+++ b/basis/tuple-arrays/tuple-arrays-tests.factor
@ -1,4 +1,5 @@
-USING: tuple-arrays sequences tools.test namespaces kernel math accessors ;
+USING: tuple-arrays sequences tools.test namespaces kernel
+math accessors ;
 IN: tuple-arrays.tests

 SYMBOL: mat
@ -9,7 +10,7 @@ C: <foo> foo
 [ T{ foo 2 1 } ] [ T{ foo 2 1 } 0 mat get [ set-nth ] keep first ] unit-test
 [ t ] [ { T{ foo f 1 } T{ foo f 2 } } >tuple-array dup mat set tuple-array? ] unit-test
 [ T{ foo f 3 } t ] 
-[ mat get [ foo-bar 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test
+[ mat get [ bar>> 2 + <foo> ] map [ first ] keep tuple-array? ] unit-test

 [ 2 ] [ 2 foo <tuple-array> dup mat set length ] unit-test
 [ T{ foo } ] [ mat get first ] unit-test
--- a/basis/ui/gadgets/canvas/canvas.factor
+++ b/basis/ui/gadgets/canvas/canvas.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: ui.backend ui.gadgets ui.gadgets.theme ui.gadgets.lib
 ui.gadgets.worlds ui.render opengl opengl.gl kernel namespaces
-classes.tuple colors ;
+classes.tuple colors accessors ;
 IN: ui.gadgets.canvas

 TUPLE: canvas < gadget dlist ;
@ -11,16 +11,16 @@ TUPLE: canvas < gadget dlist ;
    new-gadget black solid-interior ; inline

 : delete-canvas-dlist ( canvas -- )
-    dup find-gl-context
-    dup canvas-dlist [ delete-dlist ] when*
-    f swap set-canvas-dlist ;
+    [ find-gl-context ]
+    [ dlist>> [ delete-dlist ] when* ]
+    [ f >>dlist drop ] tri ;

 : make-canvas-dlist ( canvas quot -- dlist )
-    over >r GL_COMPILE swap make-dlist dup r>
-    set-canvas-dlist ;
+    [ GL_COMPILE ] dip make-dlist
+    [ >>dlist drop ] keep ;

 : cache-canvas-dlist ( canvas quot -- dlist )
-    over canvas-dlist dup
+    over dlist>> dup
    [ 2nip ] [ drop make-canvas-dlist ] if ; inline

 : draw-canvas ( canvas quot -- )
--- a/basis/ui/gadgets/lib/lib.factor
+++ b/basis/ui/gadgets/lib/lib.factor
@ -1,6 +1,8 @@

-USING: ui.backend ui.gadgets.worlds ;
+USING: accessors kernel ui.backend ui.gadgets.worlds ;

 IN: ui.gadgets.lib

-: find-gl-context ( gadget -- ) find-world world-handle select-gl-context ;
+ERROR: no-world-found ;
+: find-gl-context ( gadget -- )
+    find-world dup [ handle>> select-gl-context ] [ no-world-found ] if ;
--- a/basis/ui/gadgets/worlds/worlds-docs.factor
+++ b/basis/ui/gadgets/worlds/worlds-docs.factor
@ -46,7 +46,7 @@ HELP: <world>
 { $description "Creates a new " { $link world } " delegating to the given gadget." } ;

 HELP: find-world
-{ $values { "gadget" gadget } { "world" "a " { $link world } " or " { $link f } } }
+{ $values { "gadget" gadget } { "world/f" "a " { $link world } " or " { $link f } } }
 { $description "Finds the " { $link world } " containing the gadget, or outputs " { $link f } " if the gadget is not grafted." } ;

 HELP: draw-world
--- a/basis/ui/x11/x11.factor
+++ b/basis/ui/x11/x11.factor
@ -149,7 +149,7 @@ M: world selection-notify-event
    >r 8 PropModeReplace r>
    [
        XSelectionRequestEvent-selection
-        clipboard-for-atom x-clipboard-contents
+        clipboard-for-atom contents>>
    ] keep encode-clipboard dup length XChangeProperty drop ;

 M: world selection-request-event
@ -188,16 +188,16 @@ M: x11-ui-backend do-events
    [ [ 2dup handle-event ] assert-depth ] when 2drop ;

 : x-clipboard@ ( gadget clipboard -- prop win )
-    x-clipboard-atom swap
+    atom>> swap
    find-world handle>> window>> ;

 M: x-clipboard copy-clipboard
    [ x-clipboard@ own-selection ] keep
-    set-x-clipboard-contents ;
+    (>>contents) ;

 M: x-clipboard paste-clipboard
    >r find-world handle>> window>>
-    r> x-clipboard-atom convert-selection ;
+    r> atom>> convert-selection ;

 : init-clipboard ( -- )
    XA_PRIMARY <x-clipboard> selection set-global
--- a/basis/xml-rpc/xml-rpc.factor
+++ b/basis/xml-rpc/xml-rpc.factor
@ -48,7 +48,7 @@ TUPLE: base64 string ;
 C: <base64> base64

 M: base64 item>xml
-    base64-string >base64 "base64" build-tag ;
+    string>> >base64 "base64" build-tag ;

 : params ( seq -- xml )
    [ item>xml "value" build-tag "param" build-tag ] map
@ -80,11 +80,11 @@ C: <rpc-fault> rpc-fault

 GENERIC: send-rpc ( rpc -- xml )
 M: rpc-method send-rpc
-    [ rpc-method-name ] keep rpc-method-params method-call ;
+    [ name>> ] [ params>> ] bi method-call ;
 M: rpc-response send-rpc
-    rpc-response-params return-params ;
+    params>> return-params ;
 M: rpc-fault send-rpc
-    [ rpc-fault-code ] keep rpc-fault-string return-fault ;
+    [ code>> ] [ string>> ] bi return-fault ;

 ! * Recieving RPC requests
 ! this needs to have much better error checking
@ -96,8 +96,8 @@ TUPLE: server-error tag message ;

 M: server-error error.
    "Error in XML supplied to server" print
-    "Description: " write dup server-error-message print
-    "Tag: " write server-error-tag xml>string print ;
+    "Description: " write dup message>> print
+    "Tag: " write tag>> xml>string print ;

 PROCESS: xml>item ( tag -- object )

@ -139,8 +139,8 @@ TAG: array xml>item
    first-child-tag params>array ;

 : parse-method ( xml -- string array )
-    children-tags dup first children>string
-    swap second params>array ;
+    children-tags first2
+    [ children>string ] [ params>array ] bi* ;

 : parse-fault ( xml -- fault-code fault-string )
    first-child-tag first-child-tag first-child-tag
--- a/core/io/encodings/binary/binary-docs.factor
+++ b/core/io/encodings/binary/binary-docs.factor
@ -2,5 +2,10 @@ USING: help.syntax help.markup ;
 IN: io.encodings.binary

 HELP: binary
-{ $class-description "This is the encoding descriptor for binary I/O. Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." }
-{ $see-also "encodings-introduction" } ;
+{ $class-description "Encoding descriptor for binary I/O." } ;
+
+ARTICLE: "io.encodings.binary" "Binary encoding"
+"Making an encoded stream with the binary encoding is a no-op; streams with this encoding deal with byte-arrays, not strings." 
+{ $subsection binary } ;
+
+ABOUT: "io.encodings.binary"
--- a/core/io/encodings/utf8/utf8-docs.factor
+++ b/core/io/encodings/utf8/utf8-docs.factor
@ -2,5 +2,10 @@ USING: help.markup help.syntax ;
 IN: io.encodings.utf8

 HELP: utf8
-{ $class-description "This is the encoding descriptor for a UTF-8 encoding. UTF-8 is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences." }
-{ $see-also "encodings-introduction" } ;
+{ $class-description "Encoding descriptor for UTF-8 encoding." } ;
+
+ARTICLE: "io.encodings.utf8" "UTF-8 encoding"
+"UTF-8 is a variable-width encoding. 7-bit ASCII characters are encoded as single bytes, and other Unicode code points are encoded as 2 to 4 byte sequences."
+{ $subsection utf8 } ;
+
+ABOUT: "io.encodings.utf8"
--- a/core/math/math-docs.factor
+++ b/core/math/math-docs.factor
@ -66,7 +66,7 @@ HELP: number=
 { $notes "This word differs from " { $link = } " in that it disregards differences in type when comparing numbers." }
 { $examples
    { $example "USING: math prettyprint ;" "3.0 3 number= ." "t" }
-    { $example "USING: math prettyprint ;" "3.0 3 = ." "f" }
+    { $example "USING: kernel math prettyprint ;" "3.0 3 = ." "f" }
 } ;

 HELP: <
@ -294,7 +294,7 @@ HELP: times
 { $description "Calls the quotation " { $snippet "n" } " times." }
 { $notes "If you need to pass the current index to the quotation, use " { $link each } "." }
 { $examples
-    { $example "USING: io math ;" "3 [ \"Hi\" print ] times" "Hi\nHi\nHi\n" }
+    { $example "USING: io math ;" "3 [ \"Hi\" print ] times" "Hi\nHi\nHi" }
 } ;

 HELP: fp-nan?
@ -304,14 +304,14 @@ HELP: fp-nan?
 HELP: real-part
 { $values { "z" number } { "x" real } }
 { $description "Outputs the real part of a complex number. This acts as the identity on real numbers." }
-{ $examples { $example "C{ 1 2 } real-part ." "1" } } ;
+{ $examples { $example "USING: math prettyprint ; C{ 1 2 } real-part ." "1" } } ;

 HELP: imaginary-part
 { $values { "z" number } { "y" real } }
 { $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." }
 { $examples
-    { $example "C{ 1 2 } imaginary-part ." "2" }
-    { $example "3 imaginary-part ." "0" }
+    { $example "USING: math prettyprint ; C{ 1 2 } imaginary-part ." "2" }
+    { $example "USING: math prettyprint ; 3 imaginary-part ." "0" }
 } ;

 HELP: real
--- a/core/quotations/quotations-docs.factor
+++ b/core/quotations/quotations-docs.factor
@ -17,7 +17,7 @@ $nl
 "Wrappers are used to push words on the data stack; they evaluate to the object being wrapped:"
 { $subsection wrapper }
 { $subsection literalize }
-{ $see-also "basic-combinators" "combinators" } ;
+{ $see-also "dataflow" "combinators" } ;

 ABOUT: "quotations"

--- a/core/syntax/syntax-docs.factor
+++ b/core/syntax/syntax-docs.factor
@ -390,7 +390,7 @@ HELP: P"
 { $syntax "P\" pathname\"" }
 { $values { "pathname" "a pathname string" } }
 { $description "Reads from the input string until the next occurrence of " { $link POSTPONE: " } ", creates a new " { $link pathname } ", and appends it to the parse tree." }
-{ $examples { $example "USING: io io.files ;" "P\" foo.txt\" pathname-string print" "foo.txt" } } ;
+{ $examples { $example "USING: accessors io io.files ;" "P\" foo.txt\" string>> print" "foo.txt" } } ;

 HELP: (
 { $syntax "( inputs -- outputs )" }
--- a/core/vocabs/loader/loader-docs.factor
+++ b/core/vocabs/loader/loader-docs.factor
@ -50,7 +50,7 @@ HELP: load-vocab
 { $error-description "Thrown by " { $link POSTPONE: USE: } " and " { $link POSTPONE: USING: } " when a given vocabulary does not exist. Vocabularies must be created by " { $link POSTPONE: IN: } " before being used." } ;

 HELP: vocab-main
-{ $values { "vocab" "a vocabulary specifier" } { "main" word } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "main" word } }
 { $description "Outputs the main entry point for a vocabulary. The entry point can be executed with " { $link run } " and set with " { $link POSTPONE: MAIN: } "." } ;

 HELP: vocab-roots
--- a/core/vocabs/vocabs-docs.factor
+++ b/core/vocabs/vocabs-docs.factor
@ -46,19 +46,19 @@ HELP: vocab
 { $class-description "Instances represent vocabularies." } ;

 HELP: vocab-name
-{ $values { "vocab" "a vocabulary specifier" } { "name" string } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "name" string } }
 { $description "Outputs the name of a vocabulary." } ;

 HELP: vocab-words
-{ $values { "vocab" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "words" "an assoc mapping strings to words" } }
 { $description "Outputs the words defined in a vocabulary." } ;

 HELP: vocab-source-loaded?
-{ $values { "vocab" "a vocabulary specifier" } { "source-loaded?" "a boolean" } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
 { $description "Outputs if the source for this vocubulary has been loaded." } ;

 HELP: vocab-docs-loaded?
-{ $values { "vocab" "a vocabulary specifier" } { "docs-loaded?" "a boolean" } }
+{ $values { "vocab-spec" "a vocabulary specifier" } { "?" "a boolean" } }
 { $description "Outputs if the documentation for this vocubulary has been loaded." } ;

 HELP: words
--- a/extra/asn1/asn1.factor
+++ b/extra/asn1/asn1.factor
@ -184,7 +184,7 @@ TUPLE: tag value ;
    tagnum get (>>value) ;

 M: string >ber ( str -- byte-array )
-    tagnum get tag-value 1array "C" pack-native swap dup
+    tagnum get value>> 1array "C" pack-native swap dup
    length >ber-length-encoding swapd append swap
    >byte-array append ;

--- a/extra/boids/ui/ui.factor
+++ b/extra/boids/ui/ui.factor
@ -121,25 +121,25 @@ VARS: population-label cohesion-label alignment-label separation-label ;
    
      "1 - Randomize" [ drop randomize ] button* add-gadget
    
-      <pile> 1 over set-pack-fill
+      <pile> 1 >>fill
        population-label> add-gadget
        "3 - Add 10" [ drop add-10-boids ] button* add-gadget
        "2 - Sub 10" [ drop sub-10-boids ] button* add-gadget
      add-gadget
    
-      <pile> 1 over set-pack-fill
+      <pile> 1 >>fill
        cohesion-label> add-gadget
        "q - +0.1" [ drop inc-cohesion-weight ] button* add-gadget
        "a - -0.1" [ drop dec-cohesion-weight ] button* add-gadget
      add-gadget

-      <pile> 1 over set-pack-fill
+      <pile> 1 >>fill
        alignment-label> add-gadget
        "w - +0.1" [ drop inc-alignment-weight ] button* add-gadget
        "s - -0.1" [ drop dec-alignment-weight ] button* add-gadget
      add-gadget

-      <pile> 1 over set-pack-fill
+      <pile> 1 >>fill
        separation-label> add-gadget
        "e - +0.1" [ drop inc-separation-weight ] button* add-gadget
        "d - -0.1" [ drop dec-separation-weight ] button* add-gadget
--- a/unmaintained/bunny/authors.txt
+++ b/unmaintained/bunny/authors.txt
--- a/unmaintained/bunny/bun_zipper.ply
+++ b/unmaintained/bunny/bun_zipper.ply
--- a/unmaintained/bunny/bunny.factor
+++ b/unmaintained/bunny/bunny.factor
--- a/unmaintained/bunny/cel-shaded/cel-shaded.factor
+++ b/unmaintained/bunny/cel-shaded/cel-shaded.factor
--- a/unmaintained/bunny/deploy.factor
+++ b/unmaintained/bunny/deploy.factor
--- a/unmaintained/bunny/fixed-pipeline/fixed-pipeline.factor
+++ b/unmaintained/bunny/fixed-pipeline/fixed-pipeline.factor
--- a/unmaintained/bunny/model/model.factor
+++ b/unmaintained/bunny/model/model.factor
--- a/unmaintained/bunny/outlined/outlined.factor
+++ b/unmaintained/bunny/outlined/outlined.factor
@ -139,11 +139,7 @@ TUPLE: bunny-outlined

 : <bunny-outlined> ( gadget -- draw )
    outlining-supported? [
-        pass1-program pass2-program {
-            (>>gadget)
-            (>>pass1-program)
-            (>>pass2-program)
-        } bunny-outlined construct
+        pass1-program pass2-program f f f f f bunny-outlined boa
    ] [ drop f ] if ;

 : (framebuffer-texture) ( dim iformat xformat -- texture )
--- a/unmaintained/bunny/summary.txt
+++ b/unmaintained/bunny/summary.txt
--- a/unmaintained/bunny/tags.txt
+++ b/unmaintained/bunny/tags.txt
--- a/extra/color-picker/color-picker.factor
+++ b/extra/color-picker/color-picker.factor
@ -10,7 +10,7 @@ IN: color-picker
 ! Simple example demonstrating the use of models.

 : <color-slider> ( model -- gadget )
-    <x-slider> 1 over set-slider-line ;
+    <x-slider> 1 >>line ;

 TUPLE: color-preview < gadget ;

@ -20,7 +20,7 @@ TUPLE: color-preview < gadget ;
      { 100 100 } >>dim ;

 M: color-preview model-changed
-    swap model-value over set-gadget-interior relayout-1 ;
+    swap value>> >>interior relayout-1 ;

 : <color-model> ( model -- model )
    [ [ 256 /f ] map 1 suffix first4 rgba boa <solid> ] <filter> ;
--- a/extra/db/tuples/tuples-tests.factor
+++ b/extra/db/tuples/tuples-tests.factor
@ -41,9 +41,9 @@ SYMBOL: person4
    
    [ ] [ person1 get insert-tuple ] unit-test

-    [ 1 ] [ person1 get person-the-id ] unit-test
+    [ 1 ] [ person1 get the-id>> ] unit-test

-    [ ] [ 200 person1 get set-person-the-number ] unit-test
+    [ ] [ person1 get 200 >>the-number drop ] unit-test

    [ ] [ person1 get update-tuple ] unit-test

--- a/extra/fjsc/fjsc.factor
+++ b/extra/fjsc/fjsc.factor
@ -336,7 +336,7 @@ M: wrapper (parse-factor-quotation) ( object -- ast )
 GENERIC: fjsc-parse ( object -- ast )

 M: string fjsc-parse ( object -- ast )
-  'expression' parse parse-result-ast ;
+  'expression' parse ast>> ;

 M: quotation fjsc-parse ( object -- ast )
  [
--- a/extra/furnace/furnace.factor
+++ b/extra/furnace/furnace.factor
@ -203,6 +203,6 @@ CHLOE: button
    {
        [ [ attrs>> chloe-attrs-only ] dip add-tag-attrs ]
        [ [ attrs>> non-chloe-attrs-only ] dip "button" tag-named add-tag-attrs ]
-        [ [ children>string 1array ] dip "button" tag-named set-tag-children ]
+        [ [ children>string 1array ] dip "button" tag-named (>>children) ]
        [ nip ]
    } 2cleave process-chloe-tag ;
--- a/extra/game-input/backend/backend.factor
+++ b/extra/game-input/backend/backend.factor
@ -2,12 +2,14 @@ USING: eval multiline system combinators ;
 IN: game-input.backend

 STRING: set-backend-for-macosx
-USING: namespaces game-input.backend.iokit game-input ;
+USING: namespaces parser game-input.backend.iokit ;
+<< "game-input" (use+) >>
 iokit-game-input-backend game-input-backend set-global
 ;

 STRING: set-backend-for-windows
-USING: namespaces game-input.backend.dinput game-input ;
+USING: namespaces parser game-input.backend.dinput ;
+<< "game-input" (use+) >>
 dinput-game-input-backend game-input-backend set-global
 ;

--- a/extra/game-input/backend/dinput/dinput.factor
+++ b/extra/game-input/backend/dinput/dinput.factor
@ -1,10 +1,11 @@
-USING: windows.dinput windows.dinput.constants game-input
+USING: windows.dinput windows.dinput.constants parser
 symbols alien.c-types windows.ole32 namespaces assocs kernel
 arrays vectors windows.kernel32 windows.com windows.dinput
 shuffle windows.user32 windows.messages sequences combinators
 math.geometry.rect ui.windows accessors math windows alien
 alien.strings io.encodings.utf16 continuations byte-arrays
 locals game-input.backend.dinput.keys-array ;
+<< "game-input" (use+) >>
 IN: game-input.backend.dinput

 SINGLETON: dinput-game-input-backend
--- a/extra/game-input/backend/iokit/iokit.factor
+++ b/extra/game-input/backend/iokit/iokit.factor
@ -1,9 +1,10 @@
 USING: cocoa cocoa.plists core-foundation iokit iokit.hid
 kernel cocoa.enumeration destructors math.parser cocoa.application 
-sequences locals combinators.short-circuit game-input threads
+sequences locals combinators.short-circuit threads
 symbols namespaces assocs vectors arrays combinators
 core-foundation.run-loop accessors sequences.private
-alien.c-types math ;
+alien.c-types math parser ;
+<< "game-input" (use+) >>
 IN: game-input.backend.iokit

 SINGLETON: iokit-game-input-backend
--- a/extra/game-input/game-input.factor
+++ b/extra/game-input/game-input.factor
@ -28,7 +28,6 @@ M: f (reset-game-input) ;
 PRIVATE>

 : open-game-input ( -- )
-    load-game-input-backend
    game-input-opened? [
        (open-game-input) 
        game-input-opened on
@ -76,3 +75,6 @@ M: keyboard-state clone
    call-next-method dup keys>> clone >>keys ;

 HOOK: read-keyboard game-input-backend ( -- keyboard-state )
+
+load-game-input-backend
+
--- a/extra/gesture-logger/gesture-logger.factor
+++ b/extra/gesture-logger/gesture-logger.factor
@ -19,7 +19,7 @@ M: gesture-logger handle-gesture
    t ;

 M: gesture-logger user-input*
-    gesture-logger-stream [
+    stream>> [
        "User input: " write print
    ] with-output-stream* t ;

--- a/extra/html/streams/streams-tests.factor
+++ b/extra/html/streams/streams-tests.factor
@ -1,8 +1,6 @@
-
-USING: html.streams html.streams.private
-       io io.streams.string io.styles kernel
-       namespaces tools.test xml.writer sbufs sequences inspector colors ;
-
+USING: html.streams html.streams.private accessors io
+io.streams.string io.styles kernel namespaces tools.test
+xml.writer sbufs sequences inspector colors ;
 IN: html.streams.tests

 : make-html-string
@ -33,7 +31,7 @@ IN: html.streams.tests
 TUPLE: funky town ;

 M: funky browser-link-href
-    "http://www.funky-town.com/" swap funky-town append ;
+    "http://www.funky-town.com/" swap town>> append ;

 [ "<a href='http://www.funky-town.com/austin'>&lt;</a>" ] [
    [
--- a/extra/inverse/inverse-tests.factor
+++ b/extra/inverse/inverse-tests.factor
@ -32,7 +32,7 @@ C: <foo> foo
 : f>c ( *fahrenheit -- *celsius )
    32 - 1.8 / ;

-[ { 212 32 } ] [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
+[ { 212.0 32.0 } ] [ { 100 0 } [ [ f>c ] map ] undo ] unit-test
 [ { t t f } ] [ { t f 1 } [ [ >boolean ] matches? ] map ] unit-test
 [ { t f } ] [ { { 1 2 3 } 4 } [ [ >array ] matches? ] map ] unit-test
 [ 9 9 ] [ 3 [ 1/2 ^ ] undo 3 [ sqrt ] undo ] unit-test
--- a/extra/inverse/inverse.factor
+++ b/extra/inverse/inverse.factor
@ -208,7 +208,7 @@ DEFER: _

 : slot-readers ( class -- quot )
    all-slots rest ! tail gets rid of delegate
-    [ reader>> 1quotation [ keep ] curry ] map concat
+    [ name>> reader-word 1quotation [ keep ] curry ] map concat
    [ ] like [ drop ] compose ;

 : ?wrapped ( object -- wrapped )
--- a/extra/joystick-demo/deploy.factor
+++ b/extra/joystick-demo/deploy.factor
@ -0,0 +1,15 @@
+USING: tools.deploy.config ;
+H{
+    { deploy-name "joystick-demo" }
+    { deploy-io 2 }
+    { deploy-word-defs? f }
+    { deploy-c-types? t }
+    { deploy-random? t }
+    { deploy-word-props? f }
+    { deploy-reflection 1 }
+    { deploy-threads? t }
+    { deploy-math? t }
+    { "stop-after-last-window?" t }
+    { deploy-ui? t }
+    { deploy-compiler? t }
+}
--- a/extra/json/reader/reader-tests.factor
+++ b/extra/json/reader/reader-tests.factor
@ -11,9 +11,9 @@ IN: json.reader.tests
 { 102.0 } [ "102.0" json> ] unit-test
 { 102.5 } [ "102.5" json> ] unit-test
 { 102.5 } [ "102.50" json> ] unit-test
-{ -10250 } [ "-102.5e2" json> ] unit-test
-{ -10250 } [ "-102.5E+2" json> ] unit-test
-{ 10.25 } [ "1025e-2" json> ] unit-test
+{ -10250.0 } [ "-102.5e2" json> ] unit-test
+{ -10250.0 } [ "-102.5E+2" json> ] unit-test
+{ 10+1/4 } [ "1025e-2" json> ] unit-test
 { 0.125 } [ "0.125" json> ] unit-test
 { -0.125 } [ "-0.125" json> ] unit-test

--- a/extra/lcd/lcd.factor
+++ b/extra/lcd/lcd.factor
@ -26,7 +26,7 @@ IN: lcd
 : <time-display> ( timestamp -- gadget )
    [ hh:mm:ss lcd ] <filter> <label-control>
    "99:99:99" lcd over set-label-string
-    monospace-font over set-label-font ;
+    monospace-font >>font ;

 : time-window ( -- )
    [ time get <time-display> "Time" open-window ] with-ui ;
--- a/extra/math/derivatives/derivatives-docs.factor
+++ b/extra/math/derivatives/derivatives-docs.factor
@ -71,8 +71,8 @@ HELP: derivative-func
 { $examples
    { $example
        "USING: kernel math.derivatives math.functions math.trig prettyprint ;"
-        "60 deg>rad [ sin ] derivative-func call ."
-        "0.5000000000000173"
+        "60 deg>rad [ sin ] derivative-func call 0.5 .001 ~ ."
+        "t"
    }
    { $notes
        "Without a heavy algebraic system, derivatives must be "
--- a/extra/math/polynomials/polynomials-tests.factor
+++ b/extra/math/polynomials/polynomials-tests.factor
@ -22,7 +22,7 @@ USING: kernel math math.polynomials tools.test ;
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 } { 1 1 } p/mod ] unit-test
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 } { 1 1 0 0 0 0 0 0 } p/mod ] unit-test
 [ V{ 1 0 1 } V{ 0 0 0 } ] [ { 1 1 1 1 0 0 0 0 } { 1 1 0 0 } p/mod ] unit-test
-[ V{ 5.0 } V{ 0.0 } ] [ { 10.0 } { 2.0 } p/mod ] unit-test
+[ V{ 5.0 } V{ 0 } ] [ { 10.0 } { 2.0 } p/mod ] unit-test
 [ V{ 15/16 } V{ 0 } ] [ { 3/4 } { 4/5 } p/mod ] unit-test
 [ t ] [ { 0 1 } { 0 1 0 } p= ] unit-test
 [ f ] [ { 0 0 1 } { 0 1 0 } p= ] unit-test
--- a/extra/math/quaternions/quaternions-tests.factor
+++ b/extra/math/quaternions/quaternions-tests.factor
@ -2,11 +2,11 @@ IN: math.quaternions.tests
 USING: tools.test math.quaternions kernel math.vectors
 math.constants ;

-[ 1 ] [ qi norm ] unit-test
-[ 1 ] [ qj norm ] unit-test
-[ 1 ] [ qk norm ] unit-test
-[ 1 ] [ q1 norm ] unit-test
-[ 0 ] [ q0 norm ] unit-test
+[ 1.0 ] [ qi norm ] unit-test
+[ 1.0 ] [ qj norm ] unit-test
+[ 1.0 ] [ qk norm ] unit-test
+[ 1.0 ] [ q1 norm ] unit-test
+[ 0.0 ] [ q0 norm ] unit-test
 [ t ] [ qi qj q* qk = ] unit-test
 [ t ] [ qj qk q* qi = ] unit-test
 [ t ] [ qk qi q* qj = ] unit-test
--- a/extra/math/statistics/statistics-tests.factor
+++ b/extra/math/statistics/statistics-tests.factor
@ -5,7 +5,7 @@ IN: math.statistics.tests
 [ 3/2 ] [ { 1 2 } mean ] unit-test
 [ 0 ] [ { 0 0 0 } geometric-mean ] unit-test
 [ t ] [ { 2 2 2 2 } geometric-mean 2.0 .0001 ~ ] unit-test
-[ 1 ] [ { 1 1 1 } geometric-mean ] unit-test
+[ 1.0 ] [ { 1 1 1 } geometric-mean ] unit-test
 [ 1/3 ] [ { 1 1 1 } harmonic-mean ] unit-test

 [ 0 ] [ { 1 } range ] unit-test
@ -14,12 +14,11 @@ IN: math.statistics.tests
 [ 5/2 ] [ { 1 2 3 4 } median ] unit-test

 [ 1 ] [ { 1 2 3 } var ] unit-test
-[ 1 ] [ { 1 2 3 } std ] unit-test
+[ 1.0 ] [ { 1 2 3 } std ] unit-test
 [ t ] [ { 1 2 3 4 } ste 0.6454972243679028 - .0001 < ] unit-test

 [ t ] [ { 23.2 33.4 22.5 66.3 44.5 } std 18.1906 - .0001 < ] unit-test

 [ 0 ] [ { 1 } var ] unit-test
-[ 0 ] [ { 1 } std ] unit-test
-[ 0 ] [ { 1 } ste ] unit-test
-
+[ 0.0 ] [ { 1 } std ] unit-test
+[ 0.0 ] [ { 1 } ste ] unit-test
--- a/extra/nehe/4/4.factor
+++ b/extra/nehe/4/4.factor
@ -31,7 +31,7 @@ M: nehe4-gadget draw-gadget* ( gadget -- )
  GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  glLoadIdentity
  -1.5 0.0 -6.0 glTranslatef
-  dup nehe4-gadget-rtri 0.0 1.0 0.0 glRotatef
+  dup rtri>> 0.0 1.0 0.0 glRotatef

  GL_TRIANGLES [
    1.0 0.0 0.0 glColor3f
@ -45,7 +45,7 @@ M: nehe4-gadget draw-gadget* ( gadget -- )
  glLoadIdentity

  1.5 0.0 -6.0 glTranslatef
-  dup nehe4-gadget-rquad 1.0 0.0 0.0 glRotatef
+  dup rquad>> 1.0 0.0 0.0 glRotatef
  0.5 0.5 1.0 glColor3f
  GL_QUADS [
    -1.0 1.0 0.0 glVertex3f
--- a/extra/nehe/5/5.factor
+++ b/extra/nehe/5/5.factor
@ -30,7 +30,7 @@ M: nehe5-gadget draw-gadget* ( gadget -- )
  GL_COLOR_BUFFER_BIT GL_DEPTH_BUFFER_BIT bitor glClear
  glLoadIdentity
  -1.5 0.0 -6.0 glTranslatef
-  dup nehe5-gadget-rtri 0.0 1.0 0.0 glRotatef
+  dup rtri>> 0.0 1.0 0.0 glRotatef

  GL_TRIANGLES [
    1.0 0.0 0.0 glColor3f
@ -65,7 +65,7 @@ M: nehe5-gadget draw-gadget* ( gadget -- )
  glLoadIdentity

  1.5 0.0 -7.0 glTranslatef
-  dup nehe5-gadget-rquad 1.0 0.0 0.0 glRotatef
+  dup rquad>> 1.0 0.0 0.0 glRotatef
  GL_QUADS [
    0.0 1.0 0.0 glColor3f
    1.0 1.0 -1.0 glVertex3f
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@ -59,7 +59,7 @@ C: <token-parser> token-parser
 : case-insensitive-token ( string -- parser ) t <token-parser> ;

 M: token-parser parse ( input parser -- list )
-    dup token-parser-string swap token-parser-ignore-case?
+    [ string>> ] [ ignore-case?>> ] bi
    >r tuck r> ?string-head
    [ <parse-results> ] [ 2drop nil ] if ;

@ -76,7 +76,7 @@ M: satisfy-parser parse ( input parser -- list )
    over empty? [
        2drop nil
    ] [
-        satisfy-parser-quot >r unclip-slice dup r> call
+        quot>> >r unclip-slice dup r> call
        [ swap <parse-results> ] [ 2drop nil ] if
    ] if ;

@ -101,7 +101,7 @@ C: succeed succeed-parser ( result -- parser )
 M: succeed-parser parse ( input parser -- list )
    #! A parser that always returns 'result' as a
    #! successful parse with no input consumed.
-    succeed-parser-result swap <parse-results> ;
+    result>> swap <parse-results> ;

 TUPLE: fail-parser ;

@ -118,7 +118,7 @@ TUPLE: ensure-parser test ;
    ensure-parser boa ;

 M: ensure-parser parse ( input parser -- list )
-    2dup ensure-parser-test parse nil?
+    2dup test>> parse nil?
    [ 2drop nil ] [ drop t swap <parse-results> ] if ;

 TUPLE: ensure-not-parser test ;
@ -127,7 +127,7 @@ TUPLE: ensure-not-parser test ;
    ensure-not-parser boa ;

 M: ensure-not-parser parse ( input parser -- list )
-    2dup ensure-not-parser-test parse nil?
+    2dup test>> parse nil?
    [ drop t swap <parse-results> ] [ 2drop nil ] if ;

 TUPLE: and-parser parsers ;
@ -157,7 +157,7 @@ M: and-parser parse ( input parser -- list )
    #! two parsers. First parser1 is applied to the
    #! input then parser2 is applied to the rest of
    #! the input strings from the first parser.
-    and-parser-parsers unclip swapd parse
+    parsers>> unclip swapd parse
    [ [ and-parser-parse ] reduce ] 2curry promise ;

 TUPLE: or-parser parsers ;
@ -172,7 +172,7 @@ M: or-parser parse ( input parser1 -- list )
    #! Return the combined list resulting from the parses
    #! of parser1 and parser2 being applied to the same
    #! input. This implements the choice parsing operator.
-    or-parser-parsers 0 swap seq>list
+    parsers>> 0 swap seq>list
    [ parse ] lazy-map-with lconcat ;

 : left-trim-slice ( string -- string )
@ -191,7 +191,7 @@ C: sp sp-parser ( p1 -- parser )
 M: sp-parser parse ( input parser -- list )
    #! Skip all leading whitespace from the input then call
    #! the parser on the remaining input.
-    >r left-trim-slice r> sp-parser-p1 parse ;
+    >r left-trim-slice r> p1>> parse ;

 TUPLE: just-parser p1 ;

@ -202,7 +202,7 @@ M: just-parser parse ( input parser -- result )
    #! from the results anything where the remaining
    #! input to be parsed is not empty. So ensures a
    #! fully parsed input string.
-    just-parser-p1 parse [ parse-result-unparsed empty? ] lfilter ;
+    p1>> parse [ unparsed>> empty? ] lfilter ;

 TUPLE: apply-parser p1 quot ;

@ -214,10 +214,10 @@ M: apply-parser parse ( input parser -- result )
    #! The result of that quotation then becomes the new parse result.
    #! This allows modification of parse tree results (like
    #! converting strings to integers, etc).
-    [ apply-parser-p1 ] keep apply-parser-quot
+    [ p1>> ] [ quot>> ] bi
    -rot parse [
-        [ parse-result-parsed swap call ] keep
-        parse-result-unparsed <parse-result>
+        [ parsed>> swap call ] keep
+        unparsed>> <parse-result>
    ] lazy-map-with ;

 TUPLE: some-parser p1 ;
@ -229,7 +229,7 @@ M: some-parser parse ( input parser -- result )
    #! the parse is complete (the remaining input is empty),
    #! picks the first solution and only returns the parse
    #! tree since the remaining input is empty.
-    some-parser-p1 just parse-1 ;
+    p1>> just parse-1 ;

 : <& ( parser1 parser2 -- parser )
    #! Same as <&> except discard the results of the second parser.
@ -272,7 +272,7 @@ LAZY: only-first ( parser -- parser )
 M: only-first-parser parse ( input parser -- list )
    #! Transform a parser into a parser that only yields
    #! the first possibility.
-    only-first-parser-p1 parse 1 swap ltake ;
+    p1>> parse 1 swap ltake ;

 LAZY: <!*> ( parser -- parser )
    #! Like <*> but only return one possible result
--- a/extra/peg/ebnf/ebnf-tests.factor
+++ b/extra/peg/ebnf/ebnf-tests.factor
@ -105,11 +105,11 @@ IN: peg.ebnf.tests
 ] unit-test

 { "foo" } [
-  "foo" 'non-terminal' parse ebnf-non-terminal-symbol
+  "foo" 'non-terminal' parse symbol>>
 ] unit-test

 { "foo" } [
-  "foo]" 'non-terminal' parse ebnf-non-terminal-symbol
+  "foo]" 'non-terminal' parse symbol>>
 ] unit-test

 { V{ "a" "b" } } [
--- a/extra/processing/gadget/gadget.factor
+++ b/extra/processing/gadget/gadget.factor
@ -32,7 +32,7 @@ M: processing-gadget handle-gesture ( gesture gadget -- ? )
     {
       [ dup key-down? ]
       [
-         key-down-sym key-value set
+         sym>> key-value set
         key-pressed-value on
         key-down>> dup [ call ] [ drop ] if
         t
@ -49,7 +49,7 @@ M: processing-gadget handle-gesture ( gesture gadget -- ? )
     {
       [ dup button-down? ]
       [
-         button-down-# button-value set
+         #>> button-value set
         mouse-pressed-value on
         button-down>> dup [ call ] [ drop ] if
         t
@ -66,4 +66,4 @@ M: processing-gadget handle-gesture ( gesture gadget -- ? )
     }
     { [ t ] [ 2drop t ] }
   }
-   cond ;
+   cond ;
--- a/extra/project-euler/059/059.factor
+++ b/extra/project-euler/059/059.factor
@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays ascii assocs hashtables io.encodings.ascii io.files kernel math
    math.parser namespaces sequences sequences.lib sequences.private sorting
-    splitting grouping strings sets ;
+    splitting grouping strings sets accessors ;
 IN: project-euler.059

 ! http://projecteuler.net/index.php?section=problems&id=59
@ -60,9 +60,9 @@ TUPLE: rollover seq n ;

 C: <rollover> rollover

-M: rollover length rollover-n ;
+M: rollover length n>> ;

-M: rollover nth-unsafe rollover-seq [ length mod ] keep nth-unsafe ;
+M: rollover nth-unsafe seq>> [ length mod ] keep nth-unsafe ;

 INSTANCE: rollover immutable-sequence

--- a/extra/regexp/regexp.factor
+++ b/extra/regexp/regexp.factor
@ -323,8 +323,8 @@ TUPLE: regexp source parser ignore-case? ;

 M: regexp pprint*
    [
-        dup regexp-source
+        dup source>>
        dup find-regexp-syntax swap % swap % %
-        dup regexp-ignore-case? [ "i" % ] when
+        dup ignore-case?>> [ "i" % ] when
    ] "" make
    swap present-text ;
--- a/extra/sequences/repeating/repeating.factor
+++ b/extra/sequences/repeating/repeating.factor
@ -11,7 +11,7 @@ TUPLE: repeating circular len ;
 : repeated ( seq length -- new-seq )
    dupd <repeating> swap like ;

-M: repeating length repeating-len ;
+M: repeating length len>> ;
 M: repeating set-length (>>len) ;

 M: repeating virtual@ ( n seq -- n' seq' ) circular>> ;
--- a/extra/slides/slides.factor
+++ b/extra/slides/slides.factor
@ -61,7 +61,7 @@ IN: slides

 : page-theme ( gadget -- )
    T{ gradient f { T{ rgba f 0.8 0.8 1.0 1.0 } T{ rgba f 0.8 1.0 1.0 1.0 } } }
-    swap set-gadget-interior ;
+    >>interior drop ;

 : <page> ( list -- gadget )
    [
@ -82,8 +82,8 @@ TUPLE: slides < book ;
    [ <page> ] map 0 <model> slides new-book ;

 : change-page ( book n -- )
-    over control-value + over gadget-children length rem
-    swap gadget-model set-model ;
+    over control-value + over children>> length rem
+    swap model>> set-model ;

 : next-page ( book -- ) 1 change-page ;

--- a/extra/springies/ui/ui.factor
+++ b/extra/springies/ui/ui.factor
@ -52,16 +52,14 @@ DEFER: maybe-loop

 : springies-window* ( -- )

-  C[ display ] <slate> >slate
-    { 800 600 }                                      slate> set-slate-pdim
-    C[ { 500 500 } >world-size loop on [ run ] in-thread ]
-      slate> set-slate-graft
-    C[ loop off ]                                    slate> set-slate-ungraft
-
-  slate> "Springies" open-window ;
+  C[ display ] <slate>
+    { 800 600 } >>pdim
+    C[ { 500 500 } >world-size loop on [ run ] in-thread ] >>graft
+    C[ loop off ] >>ungraft
+  [ >slate ] [ "Springies" open-window ] bi ;

 : springies-window ( -- ) [ [ springies-window* ] with-scope ] with-ui ;

 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

-: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
+: go* ( quot -- ) '[ [ springies-window* 1000 sleep @ ] with-scope ] with-ui ;
--- a/extra/xmode/marker/marker.factor
+++ b/extra/xmode/marker/marker.factor
@ -63,10 +63,8 @@ M: f text-matches?

 M: string-matcher text-matches?
    [
-        dup string-matcher-string
-        swap string-matcher-ignore-case?
-        string-head?
-    ] keep string-matcher-string length and ;
+        [ string>> ] [ ignore-case?>> ] bi string-head?
+    ] keep string>> length and ;

 M: regexp text-matches?
    >r >string r> match-head ;
@ -177,17 +175,17 @@ M: mark-following-rule handle-rule-start
    ?end-rule
    mark-token add-remaining-token
    tuck rule-match-token* next-token,
-    f context get set-line-context-end
-    context get set-line-context-in-rule ;
+    f context get (>>end)
+    context get (>>in-rule) ;

 M: mark-following-rule handle-rule-end
    nip rule-match-token* prev-token,
-    f context get set-line-context-in-rule ;
+    f context get (>>in-rule) ;

 M: mark-previous-rule handle-rule-start
    ?end-rule
    mark-token
-    dup rule-body-token prev-token,
+    dup body-token>> prev-token,
    rule-match-token* next-token, ;

 : do-escaped ( -- )
--- a/extra/xmode/rules/rules.factor
+++ b/extra/xmode/rules/rules.factor
@ -97,7 +97,7 @@ GENERIC: text-hash-char ( text -- ch )

 M: f text-hash-char ;

-M: string-matcher text-hash-char string-matcher-string first ;
+M: string-matcher text-hash-char string>> first ;

 M: regexp text-hash-char drop f ;