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

basis/calendar/calendar-docs.factor

@@ -5,10 +5,10 @@ math.order ;
 IN: calendar
 
 HELP: duration
-{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds.  All duration slots can store " { $link real } " numbers. Compare two timestamps with the " { $link <=> } " word." } ;
+{ $description "A duration is a period of time years, months, days, hours, minutes, and seconds.  All duration slots can store " { $link real } " numbers. Compare two durations with the " { $link <=> } " word." } ;
 
 HELP: timestamp
-{ $description "A timestamp is a date and a time with a timezone offset.  Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two timestamps with the " { $link <=> } " word." } ;
+{ $description "A timestamp is a date and a time with a timezone offset.  Timestamp slots must store integers except for " { $snippet "seconds" } ", which stores reals, and " { $snippet "gmt-offset" } ", which stores a " { $link duration } ". Compare two duarionts with the " { $link <=> } " word." } ;
 
 { timestamp duration } related-words
 
@@ -135,35 +135,37 @@ HELP: instant
 
 HELP: years
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of years." } ;
 
 HELP: months
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of months." } ;
 
 HELP: days
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of days." } ;
 
 HELP: weeks
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of weeks." } ;
 
 HELP: hours
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of hours." } ;
 
 HELP: minutes
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of minutes." } ;
 
 HELP: seconds
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of seconds." } ;
 
 HELP: milliseconds
 { $values { "x" number } { "duration" duration } }
-{ $description } ;
+{ $description "Creates a duration object with the specified number of milliseconds." } ;
+
+{ years months days hours minutes seconds milliseconds } related-words
 
 HELP: leap-year?
 { $values { "obj" object } { "?" "a boolean" } }
@@ -193,75 +195,75 @@ HELP: time+
     }
 } ;
 
-HELP: dt>years
+HELP: duration>years
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in years." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "6 months dt>years ."
+               "6 months duration>years ."
                "1/2"
     }
 } ;
 
-HELP: dt>months
+HELP: duration>months
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in months." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "30 days dt>months ."
+               "30 days duration>months ."
                "16000/16233"
     }
 } ;
 
-HELP: dt>days
+HELP: duration>days
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in days." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "6 hours dt>days ."
+               "6 hours duration>days ."
                "1/4"
     }
 } ;
 
-HELP: dt>hours
+HELP: duration>hours
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in hours." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "3/4 days dt>hours ."
+               "3/4 days duration>hours ."
                "18"
     }
 } ;
-HELP: dt>minutes
+HELP: duration>minutes
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in minutes." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "6 hours dt>minutes ."
+               "6 hours duration>minutes ."
                "360"
     }
 } ;
-HELP: dt>seconds
+HELP: duration>seconds
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in seconds." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "6 minutes dt>seconds ."
+               "6 minutes duration>seconds ."
                "360"
     }
 } ;
 
-HELP: dt>milliseconds
+HELP: duration>milliseconds
 { $values { "duration" duration } { "x" number } }
 { $description "Calculates the length of a duration in milliseconds." }
 { $examples
     { $example "USING: calendar prettyprint ;"
-               "6 seconds dt>milliseconds ."
+               "6 seconds duration>milliseconds ."
                "6000"
     }
 } ;
 
-{ dt>years dt>months dt>days dt>hours dt>minutes dt>seconds dt>milliseconds } related-words
+{ duration>years duration>months duration>days duration>hours duration>minutes duration>seconds duration>milliseconds } related-words
 
 
 HELP: time-
@@ -428,16 +430,6 @@ HELP: day-of-year
     }
 } ;
 
-HELP: day-this-week
-{ $values { "timestamp" timestamp } { "n" integer } { "timestamp" timestamp } } 
-{ $description "Implementation word to calculate the day of the week relative to the timestamp. Sunday is the first day of the week, so the resulting " { $snippet "timestamp" } " will be Sunday or after, and before Saturday." }
-{ $examples
-    { $example "USING: calendar kernel prettyprint ;"
-               "now 0 day-this-week now sunday = ."
-               "t"
-    }
-} ;
-
 HELP: sunday
 { $values { "timestamp" timestamp } { "new-timestamp" timestamp } }
 { $description "Returns the Sunday from the current week, which starts on a Sunday." } ;
@@ -491,3 +483,124 @@ HELP: beginning-of-year
 HELP: time-since-midnight
 { $values { "timestamp" timestamp } { "duration" duration } }
 { $description "Calculates a " { $snippet "duration" } " that represents the elapsed time since midnight of the input " { $snippet "timestamp" } "." } ;
+
+ARTICLE: "calendar" "Calendar"
+"The two data types used throughout the calendar library:"
+{ $subsection timestamp }
+{ $subsection duration }
+"Durations represent spans of time:"
+{ $subsection "using-durations" }
+"Arithmetic on timestamps and durations:"
+{ $subsection "timestamp-arithmetic" }
+"Getting the current timestamp:"
+{ $subsection now }
+{ $subsection gmt }
+"Converting between timestamps:"
+{ $subsection >local-time }
+{ $subsection >gmt }
+"Converting between timezones:"
+{ $subsection convert-timezone }
+"Timestamps relative to each other:"
+{ $subsection "relative-timestamps" }
+"Operations on units of time:"
+{ $subsection "years" }
+{ $subsection "months" }
+{ $subsection "days" }
+"Meta-data about the calendar:"
+{ $subsection "calendar-facts" }
+;
+
+ARTICLE: "timestamp-arithmetic" "Timestamp arithmetic"
+"Adding timestamps and durations, or durations and durations:"
+{ $subsection time+ }
+"Subtracting:"
+{ $subsection time- }
+"Element-wise multiplication:"
+{ $subsection time* } ;
+
+ARTICLE: "using-durations" "Using durations"
+"Creating a duration object:"
+{ $subsection years }
+{ $subsection months }
+{ $subsection weeks }
+{ $subsection days }
+{ $subsection hours }
+{ $subsection minutes }
+{ $subsection seconds }
+{ $subsection milliseconds }
+{ $subsection instant }
+"Converting a duration to a number:"
+{ $subsection duration>years }
+{ $subsection duration>months }
+{ $subsection duration>days }
+{ $subsection duration>hours }
+{ $subsection duration>minutes }
+{ $subsection duration>seconds }
+{ $subsection duration>milliseconds } ;
+
+ARTICLE: "relative-timestamps" "Relative timestamps"
+"In the future:"
+{ $subsection hence }
+"In the past:"
+{ $subsection ago }
+"Invert a duration:"
+{ $subsection before }
+"Days of the week relative to " { $link now } ":"
+{ $subsection sunday }
+{ $subsection monday }
+{ $subsection tuesday }
+{ $subsection wednesday }
+{ $subsection thursday }
+{ $subsection friday }
+{ $subsection saturday }
+"New timestamps relative to calendar events:"
+{ $subsection beginning-of-year }
+{ $subsection beginning-of-month }
+{ $subsection beginning-of-week }
+{ $subsection midnight }
+{ $subsection noon }
+;
+
+ARTICLE: "days" "Day operations"
+"Naming days:"
+{ $subsection day-abbreviation2 }
+{ $subsection day-abbreviations2 }
+{ $subsection day-abbreviation3 }
+{ $subsection day-abbreviations3 }
+{ $subsection day-name }
+{ $subsection day-names }
+"Calculating a Julian day number:"
+{ $subsection julian-day-number }
+"Calculate a timestamp:"
+{ $subsection julian-day-number>date }
+;
+
+ARTICLE: "calendar-facts" "Calendar facts"
+"Calendar facts:"
+{ $subsection average-month }
+{ $subsection months-per-year }
+{ $subsection days-per-year }
+{ $subsection hours-per-year }
+{ $subsection minutes-per-year }
+{ $subsection seconds-per-year }
+{ $subsection days-in-month }
+{ $subsection day-of-year }
+{ $subsection day-of-week }
+;
+
+ARTICLE: "years" "Year operations"
+"Leap year predicate:"
+{ $subsection leap-year? }
+"Find the number of days in a year:"
+{ $subsection days-in-year }
+;
+
+ARTICLE: "months" "Month operations"
+"Naming months:"
+{ $subsection month-name }
+{ $subsection month-names }
+{ $subsection month-abbreviation }
+{ $subsection month-abbreviations }
+;
+
+ABOUT: "calendar"

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+
+[ +eq+ ] [ 2006 10 10 0 0 0 instant <timestamp> 10.5 minutes time+
-        2006 10 10 0 10 30 instant <timestamp> = ] unit-test
+        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+

basis/calendar/calendar.factor

@@ -240,7 +240,7 @@ M: duration time+
         2drop <duration>
     ] if ;
 
-: dt>years ( duration -- x )
+: duration>years ( duration -- x )
     #! Uses average month/year length since duration loses calendar
     #! data
     0 swap
@@ -253,14 +253,14 @@ M: duration time+
         [ second>> seconds-per-year / + ]
     } cleave ;
 
-M: duration <=> [ dt>years ] compare ;
+M: duration <=> [ duration>years ] compare ;
 
-: dt>months ( duration -- x ) dt>years months-per-year * ;
+: duration>months ( duration -- x ) duration>years months-per-year * ;
-: dt>days ( duration -- x ) dt>years days-per-year * ;
+: duration>days ( duration -- x ) duration>years days-per-year * ;
-: dt>hours ( duration -- x ) dt>years hours-per-year * ;
+: duration>hours ( duration -- x ) duration>years hours-per-year * ;
-: dt>minutes ( duration -- x ) dt>years minutes-per-year * ;
+: duration>minutes ( duration -- x ) duration>years minutes-per-year * ;
-: dt>seconds ( duration -- x ) dt>years seconds-per-year * ;
+: duration>seconds ( duration -- x ) duration>years seconds-per-year * ;
-: dt>milliseconds ( duration -- x ) dt>seconds 1000 * ;
+: duration>milliseconds ( duration -- x ) duration>seconds 1000 * ;
 
 GENERIC: time- ( time1 time2 -- time3 )
 
@@ -364,11 +364,13 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
 : day-of-year ( timestamp -- n )
     >date< (day-of-year) ;
 
+<PRIVATE
 : day-offset ( timestamp m -- timestamp n )
     over day-of-week - ; inline
 
 : day-this-week ( timestamp n -- timestamp )
     day-offset days time+ ;
+PRIVATE>
 
 : sunday ( timestamp -- new-timestamp ) 0 day-this-week ;
 : monday ( timestamp -- new-timestamp ) 1 day-this-week ;

basis/calendar/format/format-tests.factor

@@ -3,23 +3,23 @@ io.streams.string accessors io math.order ;
 IN: calendar.format.tests
 
 [ 0 ] [
-    "Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
+    "Z" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
 ] unit-test
 
 [ 1 ] [
-    "+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
+    "+01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
 ] unit-test
 
 [ -1 ] [
-    "-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
+    "-01" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
 ] unit-test
 
 [ -1-1/2 ] [
-    "-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
+    "-01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
 ] unit-test
 
 [ 1+1/2 ] [
-    "+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader dt>hours
+    "+01:30" [ read1 read-rfc3339-gmt-offset ] with-string-reader duration>hours
 ] unit-test
 
 [ ] [ now timestamp>rfc3339 drop ] unit-test
@@ -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

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
+    [ [ \ to , id>> , , ] { } make ] keep
-    remote-channel-node "remote-channels" <remote-process> 
+    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
+    [ [ \ from , id>> , ] { } make ] keep
-    remote-channel-node "remote-channels" <remote-process> 
+    node>> "remote-channels" <remote-process> 
     send-synchronous dup no-channel = [ no-channel throw ] when* ;
 
 [

basis/cocoa/cocoa-tests.factor

@@ -20,10 +20,10 @@ CLASS: {
 
 test-foo
 
-[ 1 ] [ "x" get NSRect-x ] unit-test
+[ 1.0 ] [ "x" get NSRect-x ] unit-test
-[ 2 ] [ "x" get NSRect-y ] unit-test
+[ 2.0 ] [ "x" get NSRect-y ] unit-test
-[ 101 ] [ "x" get NSRect-w ] unit-test
+[ 101.0 ] [ "x" get NSRect-w ] unit-test
-[ 102 ] [ "x" get NSRect-h ] unit-test
+[ 102.0 ] [ "x" get NSRect-h ] unit-test
 
 CLASS: {
     { +superclass+ "NSObject" }
@@ -41,7 +41,7 @@ Bar [
     -> release
 ] compile-call
 
-[ 1 ] [ "x" get NSRect-x ] unit-test
+[ 1.0 ] [ "x" get NSRect-x ] unit-test
-[ 2 ] [ "x" get NSRect-y ] unit-test
+[ 2.0 ] [ "x" get NSRect-y ] unit-test
-[ 101 ] [ "x" get NSRect-w ] unit-test
+[ 101.0 ] [ "x" get NSRect-w ] unit-test
-[ 102 ] [ "x" get NSRect-h ] unit-test
+[ 102.0 ] [ "x" get NSRect-h ] unit-test

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"

basis/compiler/tests/alien.factor

@@ -109,7 +109,7 @@ unit-test
 << "f-stdcall" f "stdcall" add-library >>
 
 [ f ] [ "f-stdcall" load-library ] unit-test
-[ "stdcall" ] [ "f-stdcall" library library-abi ] unit-test
+[ "stdcall" ] [ "f-stdcall" library abi>> ] unit-test
 
 : ffi_test_18 ( w x y z -- int )
     "int" "f-stdcall" "ffi_test_18" { "int" "int" "int" "int" }

basis/compiler/tests/optimizer.factor

@@ -210,10 +210,10 @@ USE: binary-search.private
 
 : old-binsearch ( elt quot seq -- elt quot i )
     dup length 1 <= [
-        slice-from
+        from>>
     ] [
         [ midpoint swap call ] 3keep roll dup zero?
-        [ drop dup slice-from swap midpoint@ + ]
+        [ drop dup from>> swap midpoint@ + ]
         [ dup midpoint@ cut-slice old-binsearch ] if
     ] if ; inline
 

basis/compiler/tests/stack-trace.factor

@@ -1,10 +1,10 @@
 IN: compiler.tests
 USING: compiler tools.test namespaces sequences
 kernel.private kernel math continuations continuations.private
-words splitting grouping sorting ;
+words splitting grouping sorting accessors ;
 
 : symbolic-stack-trace ( -- newseq )
-    error-continuation get continuation-call callstack>array
+    error-continuation get call>> callstack>array
     2 group flip first ;
 
 : foo ( -- * ) 3 throw 7 ;

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -229,10 +229,6 @@ M: float detect-float ;
     \ detect-float inlined?
 ] unit-test
 
-[ t ] [
-    [ 3 + = ] \ equal? inlined?
-] unit-test
-
 [ f ] [
     [ { fixnum fixnum } declare 7 bitand neg shift ]
     \ fixnum-shift-fast inlined?

basis/compiler/tree/finalization/finalization.factor

@@ -1,7 +1,15 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences
+USING: kernel accessors sequences words namespaces
-compiler.tree compiler.tree.combinators ;
+classes.builtin
+compiler.tree
+compiler.tree.builder
+compiler.tree.normalization
+compiler.tree.propagation
+compiler.tree.cleanup
+compiler.tree.def-use
+compiler.tree.dead-code
+compiler.tree.combinators ;
 IN: compiler.tree.finalization
 
 GENERIC: finalize* ( node -- nodes )
@@ -13,6 +21,25 @@ M: #shuffle finalize*
     [ in>> ] [ out>> ] bi sequence=
     [ drop f ] when ;
 
+: builtin-predicate? ( word -- ? )
+    "predicating" word-prop builtin-class? ;
+
+: splice-quot ( quot -- nodes )
+    [
+        build-tree
+        normalize
+        propagate
+        cleanup
+        compute-def-use
+        remove-dead-code
+        but-last
+    ] with-scope ;
+
+M: #call finalize*
+    dup word>> builtin-predicate? [
+        word>> def>> splice-quot
+    ] when ;
+
 M: node finalize* ;
 
 : finalize ( nodes -- nodes' ) [ finalize* ] map-nodes ;

basis/compiler/tree/propagation/info/info.factor

@@ -59,10 +59,38 @@ slots ;
 
 : <value-info> ( -- info ) \ value-info new ;
 
+: read-only-slots ( values class -- slots )
+    #! Delegation.
+    all-slots rest-slice
+    [ read-only>> [ drop f ] unless ] 2map
+    { f f } prepend ;
+
+DEFER: <literal-info>
+
+: init-literal-info ( info -- info )
+    #! Delegation.
+    dup literal>> class >>class
+    dup literal>> dup real? [ [a,a] >>interval ] [
+        [ [-inf,inf] >>interval ] dip
+        {
+            { [ dup complex? ] [
+                [ real-part <literal-info> ]
+                [ imaginary-part <literal-info> ] bi
+                2array >>slots
+            ] }
+            { [ dup tuple? ] [
+                [
+                    tuple-slots rest-slice
+                    [ <literal-info> ] map
+                ] [ class ] bi read-only-slots >>slots
+            ] }
+            [ drop ]
+        } cond
+    ] if ; inline
+
 : init-value-info ( info -- info )
     dup literal?>> [
-        dup literal>> class >>class
+        init-literal-info
-        dup literal>> dup real? [ [a,a] ] [ drop [-inf,inf] ] if >>interval
     ] [
         dup [ class>> null-class? ] [ interval>> empty-interval eq? ] bi or [
             null >>class
@@ -73,7 +101,7 @@ slots ;
             dup [ class>> ] [ interval>> ] bi interval>literal
             [ >>literal ] [ >>literal? ] bi*
         ] if
-    ] if ;
+    ] if ; inline
 
 : <class/interval-info> ( class interval -- info )
     <value-info>

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -211,7 +211,7 @@ generic-comparison-ops [
 \ eq? [
     [ info-intervals-intersect? ]
     [ info-classes-intersect? ]
-    2bi or maybe-or-never
+    2bi and maybe-or-never
 ] "outputs" set-word-prop
 
 {

basis/compiler/tree/propagation/propagation-tests.factor

@@ -411,6 +411,14 @@ TUPLE: mixed-mutable-immutable { x integer } { y sequence read-only } ;
     ] final-classes
 ] unit-test
 
+[ V{ integer array } ] [
+    [
+        [ 2drop T{ mixed-mutable-immutable f 3 { } } ]
+        [ { array } declare mixed-mutable-immutable boa ] if
+        [ x>> ] [ y>> ] bi
+    ] final-classes
+] unit-test
+
 ! Recursive propagation
 : recursive-test-1 ( a -- b ) recursive-test-1 ; inline recursive
 
@@ -573,6 +581,18 @@ MIXIN: empty-mixin
 
 [ V{ fixnum } ] [ [ [ bignum-shift drop ] keep ] final-classes ] unit-test
 
+[ V{ float } ] [
+    [
+        [ { float float } declare <complex> ]
+        [ 2drop C{ 0.0 0.0 } ]
+        if real-part
+    ] final-classes
+] unit-test
+
+[ V{ POSTPONE: f } ] [
+    [ { float } declare 0 eq? ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test

basis/compiler/tree/propagation/slots/slots.factor

@@ -31,12 +31,6 @@ UNION: fixed-length-sequence array byte-array string ;
 : tuple-constructor? ( word -- ? )
     { <tuple-boa> <complex> } memq? ;
 
-: read-only-slots ( values class -- slots )
-    #! Delegation.
-    all-slots rest-slice
-    [ read-only>> [ drop f ] unless ] 2map
-    { f f } prepend ;
-
 : fold-<tuple-boa> ( values class -- info )
     [ , f , [ literal>> ] map % ] { } make >tuple
     <literal-info> ;

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 -- )

basis/cpu/ppc/architecture/architecture.factor

@@ -18,13 +18,13 @@ IN: cpu.ppc.architecture
 : ds-reg 14 ; inline
 : rs-reg 15 ; inline
 
-: reserved-area-size
+: reserved-area-size ( -- n )
     os {
         { linux [ 2 ] }
         { macosx [ 6 ] }
     } case cells ; foldable
 
-: lr-save
+: lr-save ( -- n )
     os {
         { linux [ 1 ] }
         { macosx [ 2 ] }
@@ -32,12 +32,12 @@ IN: cpu.ppc.architecture
 
 : param@ ( n -- x ) reserved-area-size + ; inline
 
-: param-save-size 8 cells ; foldable
+: param-save-size ( -- n ) 8 cells ; foldable
 
 : local@ ( n -- x )
     reserved-area-size param-save-size + + ; inline
 
-: factor-area-size 2 cells ;
+: factor-area-size ( -- n ) 2 cells ; foldable
 
 : next-save ( n -- i ) cell - ;
 
@@ -96,9 +96,9 @@ M: ppc %epilogue ( n -- )
     1 1 rot ADDI
     0 MTLR ;
 
-: (%call) 11 MTLR BLRL ;
+: (%call) ( -- ) 11 MTLR BLRL ;
 
-: (%jump) 11 MTCTR BCTR ;
+: (%jump) ( -- ) 11 MTCTR BCTR ;
 
 : %load-dlsym ( symbol dll register -- )
     0 swap LOAD32 rc-absolute-ppc-2/2 rel-dlsym ;
@@ -218,7 +218,7 @@ M: ppc %box-long-long ( n func -- )
         4 1 rot cell + local@ LWZ
     ] when* r> f %alien-invoke ;
 
-: temp@ stack-frame* factor-area-size - swap - ;
+: temp@ ( m -- n ) stack-frame* factor-area-size - swap - ;
 
 : struct-return@ ( size n -- n ) [ local@ ] [ temp@ ] ?if ;
 

basis/cpu/ppc/intrinsics/intrinsics.factor

@@ -11,17 +11,17 @@ math.floats.private classes slots.private combinators
 compiler.constants ;
 IN: cpu.ppc.intrinsics
 
-: %slot-literal-known-tag
+: %slot-literal-known-tag ( -- out value offset )
     "val" operand
     "obj" operand
     "n" get cells
     "obj" get operand-tag - ;
 
-: %slot-literal-any-tag
+: %slot-literal-any-tag ( -- out value offset )
     "obj" operand "scratch1" operand %untag
     "val" operand "scratch1" operand "n" get cells ;
 
-: %slot-any
+: %slot-any ( -- out value offset )
     "obj" operand "scratch1" operand %untag
     "offset" operand "n" operand 1 SRAWI
     "scratch1" operand "val" operand "offset" operand ;
@@ -188,7 +188,7 @@ IN: cpu.ppc.intrinsics
     }
 } define-intrinsics
 
-: generate-fixnum-mod
+: generate-fixnum-mod ( -- )
     #! PowerPC doesn't have a MOD instruction; so we compute
     #! x-(x/y)*y. Puts the result in "s" operand.
     "s" operand "r" operand "y" operand MULLW
@@ -259,7 +259,7 @@ IN: cpu.ppc.intrinsics
 \ fixnum+ \ ADD \ ADDO. overflow-template
 \ fixnum- \ SUBF \ SUBFO. overflow-template
 
-: generate-fixnum/i
+: generate-fixnum/i ( -- )
     #! This VOP is funny. If there is an overflow, it falls
     #! through to the end, and the result is in "x" operand.
     #! Otherwise it jumps to the "no-overflow" label and the
@@ -514,8 +514,8 @@ IN: cpu.ppc.intrinsics
 ! Alien intrinsics
 : %alien-accessor ( quot -- )
     "offset" operand dup %untag-fixnum
-    "offset" operand dup "alien" operand ADD
+    "scratch" operand "offset" operand "alien" operand ADD
-    "value" operand "offset" operand 0 roll call ; inline
+    "value" operand "scratch" operand 0 roll call ; inline
 
 : alien-integer-get-template
     H{
@@ -539,6 +539,7 @@ IN: cpu.ppc.intrinsics
             { unboxed-c-ptr "alien" c-ptr }
             { f "offset" fixnum }
         } }
+        { +scratch+ { { f "scratch" } } }
         { +clobber+ { "value" "offset" } }
     } ;
 

basis/db/db-tests.factor

@@ -1,5 +1,5 @@
-IN: db.tests
 USING: tools.test db kernel ;
+IN: db.tests
 
 { 1 0 } [ [ drop ] query-each ] must-infer-as
 { 1 1 } [ [ ] query-map ] must-infer-as

basis/db/db.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs classes continuations destructors kernel math
 namespaces sequences sequences.lib classes.tuple words strings
-tools.walker accessors combinators.lib ;
+tools.walker accessors combinators.lib combinators ;
 IN: db
 
 TUPLE: db
@@ -15,24 +15,25 @@ TUPLE: db
     new
         H{ } clone >>insert-statements
         H{ } clone >>update-statements
-        H{ } clone >>delete-statements ;
+        H{ } clone >>delete-statements ; inline
 
-GENERIC: make-db* ( seq class -- db )
+GENERIC: make-db* ( seq db -- db )
 
-: make-db ( seq class -- db )
+: make-db ( seq class -- db ) new-db make-db* ;
-    new-db make-db* ;
 
 GENERIC: db-open ( db -- db )
 HOOK: db-close db ( handle -- )
 
 : dispose-statements ( assoc -- ) values dispose-each ;
 
-: dispose-db ( db -- ) 
+: db-dispose ( db -- ) 
     dup db [
-        dup insert-statements>> dispose-statements
+        {
-        dup update-statements>> dispose-statements
+            [ insert-statements>> dispose-statements ]
-        dup delete-statements>> dispose-statements
+            [ update-statements>> dispose-statements ]
-        handle>> db-close
+            [ delete-statements>> dispose-statements ]
+            [ handle>> db-close ]
+        } cleave
     ] with-variable ;
 
 TUPLE: statement handle sql in-params out-params bind-params bound? type retries ;
@@ -47,8 +48,8 @@ TUPLE: result-set sql in-params out-params handle n max ;
         swap >>in-params
         swap >>sql ;
 
-HOOK: <simple-statement> db ( str in out -- statement )
+HOOK: <simple-statement> db ( string in out -- statement )
-HOOK: <prepared-statement> db ( str in out -- statement )
+HOOK: <prepared-statement> db ( string in out -- statement )
 GENERIC: prepare-statement ( statement -- )
 GENERIC: bind-statement* ( statement -- )
 GENERIC: low-level-bind ( statement -- )

basis/db/errors/errors.factor

@@ -6,6 +6,5 @@ IN: db.errors
 ERROR: db-error ;
 ERROR: sql-error ;
 
-
 ERROR: table-exists ;
 ERROR: bad-schema ;

basis/db/postgresql/postgresql.factor

@@ -16,7 +16,7 @@ TUPLE: postgresql-statement < statement ;
 
 TUPLE: postgresql-result-set < result-set ;
 
-M: postgresql-db make-db* ( seq tuple -- db )
+M: postgresql-db make-db* ( seq db -- db )
     >r first4 r>
         swap >>db
         swap >>pass

basis/db/queries/queries.factor

@@ -43,13 +43,6 @@ M: random-id-generator eval-generator ( singleton -- obj )
 : interval-comparison ( ? str -- str )
     "from" = " >" " <" ? swap [ "= " append ] when ;
 
-: fp-infinity? ( float -- ? )
-    dup float? [
-        double>bits -52 shift 11 2^ 1- [ bitand ] keep =
-    ] [
-        drop f
-    ] if ;
-
 : (infinite-interval?) ( interval -- ?1 ?2 )
     [ from>> ] [ to>> ] bi
     [ first fp-infinity? ] bi@ ;

basis/db/sqlite/ffi/ffi.factor

@@ -118,6 +118,7 @@ FUNCTION: int sqlite3_bind_blob ( sqlite3_stmt* pStmt, int index, void* ptr, int
 FUNCTION: int sqlite3_bind_double ( sqlite3_stmt* pStmt, int index, double x ) ;
 FUNCTION: int sqlite3_bind_int ( sqlite3_stmt* pStmt, int index, int n ) ;
 FUNCTION: int sqlite3_bind_int64 ( sqlite3_stmt* pStmt, int index, sqlite3_int64 n ) ;
+! Bind the same function as above, but for unsigned 64bit integers
 : sqlite3-bind-uint64 ( pStmt index in64 -- int )
     "int" "sqlite" "sqlite3_bind_int64"
     { "sqlite3_stmt*" "int" "sqlite3_uint64" } alien-invoke ;
@@ -131,6 +132,7 @@ FUNCTION: int sqlite3_column_bytes ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: char* sqlite3_column_decltype ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: int sqlite3_column_int ( sqlite3_stmt* pStmt, int col ) ;
 FUNCTION: sqlite3_int64 sqlite3_column_int64 ( sqlite3_stmt* pStmt, int col ) ;
+! Bind the same function as above, but for unsigned 64bit integers
 : sqlite3-column-uint64 ( pStmt col -- uint64 )
     "sqlite3_uint64" "sqlite" "sqlite3_column_int64"
     { "sqlite3_stmt*" "int" } alien-invoke ;

basis/db/sqlite/sqlite-tests.factor

@@ -57,8 +57,7 @@ IN: db.sqlite.tests
     ] with-db
 ] unit-test
 
-[
+[ ] [
-] [
     test.db [
         [
             "insert into person(name, country) values('Jose', 'Mexico')"

basis/db/sqlite/sqlite.factor

@@ -19,7 +19,7 @@ M: sqlite-db db-open ( db -- db )
     dup path>> sqlite-open >>handle ;
 
 M: sqlite-db db-close ( handle -- ) sqlite-close ;
-M: sqlite-db dispose ( db -- ) dispose-db ;
+M: sqlite-db dispose ( db -- ) db-dispose ;
 
 TUPLE: sqlite-statement < statement ;
 
@@ -52,12 +52,12 @@ M: sqlite-result-set dispose ( result-set -- )
     handle>> [ sqlite3_reset drop ] [ sqlite3_clear_bindings drop ] bi ;
 
 M: sqlite-statement low-level-bind ( statement -- )
-    [ statement-bind-params ] [ statement-handle ] bi
+    [ bind-params>> ] [ handle>> ] bi
     [ swap [ key>> ] [ value>> ] [ type>> ] tri sqlite-bind-type ] curry each ;
 
 M: sqlite-statement bind-statement* ( statement -- )
     sqlite-maybe-prepare
-    dup statement-bound? [ dup reset-bindings ] when
+    dup bound?>> [ dup reset-bindings ] when
     low-level-bind ;
 
 GENERIC: sqlite-bind-conversion ( tuple obj -- array )

basis/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
 

basis/db/types/types.factor

@@ -8,7 +8,7 @@ classes.singleton accessors quotations random ;
 IN: db.types
 
 HOOK: persistent-table db ( -- hash )
-HOOK: compound db ( str obj -- hash )
+HOOK: compound db ( string obj -- hash )
 
 TUPLE: sql-spec class slot-name column-name type primary-key modifiers ;
 
@@ -78,7 +78,7 @@ FACTOR-BLOB NULL URL ;
         swap >>class
     dup normalize-spec ;
 
-: number>string* ( n/str -- str )
+: number>string* ( n/string -- string )
     dup number? [ number>string ] when ;
 
 : remove-db-assigned-id ( specs -- obj )
@@ -97,7 +97,7 @@ FACTOR-BLOB NULL URL ;
 
 ERROR: unknown-modifier ;
 
-: lookup-modifier ( obj -- str )
+: lookup-modifier ( obj -- string )
     {
         { [ dup array? ] [ unclip lookup-modifier swap compound ] }
         [ persistent-table at* [ unknown-modifier ] unless third ]
@@ -105,43 +105,43 @@ ERROR: unknown-modifier ;
 
 ERROR: no-sql-type ;
 
-: (lookup-type) ( obj -- str )
+: (lookup-type) ( obj -- string )
     persistent-table at* [ no-sql-type ] unless ;
 
-: lookup-type ( obj -- str )
+: lookup-type ( obj -- string )
     dup array? [
         unclip (lookup-type) first nip
     ] [
         (lookup-type) first
     ] if ;
 
-: lookup-create-type ( obj -- str )
+: lookup-create-type ( obj -- string )
     dup array? [
         unclip (lookup-type) second swap compound
     ] [
         (lookup-type) second
     ] if ;
 
-: single-quote ( str -- newstr )
+: single-quote ( string -- new-string )
     "'" swap "'" 3append ;
 
-: double-quote ( str -- newstr )
+: double-quote ( string -- new-string )
     "\"" swap "\"" 3append ;
 
-: paren ( str -- newstr )
+: paren ( string -- new-string )
     "(" swap ")" 3append ;
 
-: join-space ( str1 str2 -- newstr )
+: join-space ( string1 string2 -- new-string )
     " " swap 3append ;
 
-: modifiers ( spec -- str )
+: modifiers ( spec -- string )
     modifiers>> [ lookup-modifier ] map " " join
     dup empty? [ " " prepend ] unless ;
 
 HOOK: bind% db ( spec -- )
 HOOK: bind# db ( spec obj -- )
 
-: offset-of-slot ( str obj -- n )
+: offset-of-slot ( string obj -- n )
     class superclasses [ "slots" word-prop ] map concat
     slot-named offset>> ;
 

basis/debugger/debugger-docs.factor

@@ -1,7 +1,7 @@
 USING: alien arrays generic generic.math help.markup help.syntax
 kernel math memory strings sbufs vectors io io.files classes
-help generic.standard continuations system debugger.private
+help generic.standard continuations system io.files.private
-io.files.private listener ;
+listener ;
 IN: debugger
 
 ARTICLE: "debugger" "The debugger"
@@ -22,8 +22,6 @@ ARTICLE: "debugger" "The debugger"
 { $subsection :2 }
 { $subsection :3 }
 { $subsection :res }
-"Assertions:"
-{ $subsection "errors-assert" }
 "You can read more about error handling in " { $link "errors" } "." ;
 
 ABOUT: "debugger"

basis/delegate/delegate-tests.factor

@@ -15,7 +15,7 @@ GENERIC# whoa 1 ( s t -- w )
 PROTOCOL: baz foo { bar 0 } { whoa 1 } ;
 
 : hello-test ( hello/goodbye -- array )
-    [ hello? ] [ hello-this ] [ hello-that ] tri 3array ;
+    [ hello? ] [ this>> ] [ that>> ] tri 3array ;
 
 CONSULT: baz goodbye these>> ;
 M: hello foo this>> ;
@@ -34,8 +34,8 @@ M: hello bing hello-test ;
 [ 3 ] [ 1 0 <hello> 2 whoa ] unit-test
 [ 3 ] [ 1 0 <hello> f <goodbye> 2 whoa ] unit-test
 
-[ ] [ 3 [ "USE: delegate IN: delegate.tests CONSULT: baz goodbye goodbye-these ;" eval ] times ] unit-test
+[ ] [ 3 [ "USING: accessors delegate ; IN: delegate.tests CONSULT: baz goodbye these>> ;" eval ] times ] unit-test
-[ H{ { goodbye [ goodbye-these ] } } ] [ baz protocol-consult ] unit-test
+[ H{ { goodbye [ these>> ] } } ] [ baz protocol-consult ] unit-test
 [ H{ } ] [ bee protocol-consult ] unit-test
 
 [ "USING: delegate ;\nIN: delegate.tests\nPROTOCOL: baz foo bar { whoa 1 } ;\n" ] [ [ baz see ] with-string-writer ] unit-test

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

basis/help/definitions/definitions-tests.factor

@@ -1,6 +1,6 @@
 USING: math definitions help.topics help tools.test
 prettyprint parser io.streams.string kernel source-files
-assocs namespaces words io sequences eval ;
+assocs namespaces words io sequences eval accessors ;
 IN: help.definitions.tests
 
 [ ] [ \ + >link see ] unit-test
@@ -10,7 +10,7 @@ IN: help.definitions.tests
         "IN: help.definitions.tests USING: help.syntax ; : hello ; HELP: hello \"test\" ; ARTICLE: \"hello\" \"world\" ; ARTICLE: \"hello2\" \"world\" ;" <string-reader> "foo"
         parse-stream drop
 
-        "foo" source-file source-file-definitions first assoc-size
+        "foo" source-file definitions>> first assoc-size
     ] unit-test
 
     [ t ] [ "hello" articles get key? ] unit-test
@@ -23,7 +23,7 @@ IN: help.definitions.tests
         "IN: help.definitions.tests USING: help.syntax ; : hello ; ARTICLE: \"hello\" \"world\" ;" <string-reader> "foo"
         parse-stream drop
 
-        "foo" source-file source-file-definitions first assoc-size
+        "foo" source-file definitions>> first assoc-size
     ] unit-test
 
     [ t ] [ "hello" articles get key? ] unit-test

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:  } "." } ;

basis/help/markup/markup-tests.factor

@@ -1,13 +1,13 @@
 USING: definitions help help.markup kernel sequences tools.test
-words parser namespaces assocs generic io.streams.string ;
+words parser namespaces assocs generic io.streams.string accessors ;
 IN: help.markup.tests
 
 TUPLE: blahblah quux ;
 
 [ "an int" ] [ [ { "int" } $instance ] with-string-writer ] unit-test
 
-[ ] [ \ blahblah-quux help ] unit-test
+[ ] [ \ quux>> help ] unit-test
-[ ] [ \ set-blahblah-quux help ] unit-test
+[ ] [ \ >>quux help ] unit-test
 [ ] [ \ blahblah? help ] unit-test
 
 : fooey "fooey" throw ;

basis/help/syntax/syntax-tests.factor

@@ -1,5 +1,6 @@
+USING: kernel tools.test parser vocabs help.syntax namespaces
+eval accessors ;
 IN: help.syntax.tests
-USING: tools.test parser vocabs help.syntax namespaces eval ;
 
 [
     [ "foobar" ] [
@@ -12,5 +13,5 @@ USING: tools.test parser vocabs help.syntax namespaces eval ;
         "help.syntax.tests" vocab vocab-help
     ] unit-test
     
-    [ ] [ f "help.syntax.tests" vocab set-vocab-help ] unit-test
+    [ ] [ "help.syntax.tests" vocab f >>help drop ] unit-test
 ] with-file-vocabs

basis/help/topics/topics-docs.factor

@@ -1,5 +1,6 @@
-USING: help.markup help.syntax help.topics help.crossref help io
+USING: help.markup help.syntax help.crossref help io io.styles
-io.styles hashtables ;
+hashtables strings ;
+IN: help.topics
 
 HELP: articles
 { $var-description "Hashtable mapping article names to " { $link article } " instances." } ;
@@ -14,11 +15,11 @@ HELP: article
 { $description "Outputs a named " { $link article } " object." } ;
 
 HELP: article-title
-{ $values { "article" "an article name or a word" } { "title" "a string" } }
+{ $values { "topic" "an article name or a word" } { "string" string } }
 { $description "Outputs the title of a specific help article." } ;
 
 HELP: article-content
-{ $values { "article" "an article name or a word" } { "content" "a markup element" } }
+{ $values { "topic" "an article name or a word" } { "content" "a markup element" } }
 { $description "Outputs the content of a specific help article." } ;
 
 HELP: all-articles

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 } ;
 

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." }
+{ $class-description "ASCII encoding descriptor." } ;
-{ $see-also "encodings-introduction" } ;
+
+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"

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 }

basis/io/sockets/sockets.factor

@@ -72,8 +72,8 @@ M: inet4 sockaddr-type drop "sockaddr-in" c-type ;
 M: inet4 make-sockaddr ( inet -- sockaddr )
     "sockaddr-in" <c-object>
     AF_INET over set-sockaddr-in-family
-    over inet4-port htons over set-sockaddr-in-port
+    over port>> htons over set-sockaddr-in-port
-    over inet4-host
+    over host>>
     "0.0.0.0" or
     rot inet-pton *uint over set-sockaddr-in-addr ;
 
@@ -134,8 +134,8 @@ M: inet6 sockaddr-type drop "sockaddr-in6" c-type ;
 M: inet6 make-sockaddr ( inet -- sockaddr )
     "sockaddr-in6" <c-object>
     AF_INET6 over set-sockaddr-in6-family
-    over inet6-port htons over set-sockaddr-in6-port
+    over port>> htons over set-sockaddr-in6-port
-    over inet6-host "::" or
+    over host>> "::" or
     rot inet-pton over set-sockaddr-in6-addr ;
 
 M: inet6 parse-sockaddr

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
+    dup handle>> exit-code
-    over process-handle dispose-process
+    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

basis/math/complex/complex-docs.factor

@@ -2,18 +2,24 @@ USING: help.markup help.syntax math math.private math.functions
 math.complex.private ;
 IN: math.complex
 
+ARTICLE: "complex-numbers-zero" "Embedding of real numbers in complex numbers"
+"Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:"
+{ $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" }
+"Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:"
+{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ 2.0 0.0 }" }
+"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ;
+
 ARTICLE: "complex-numbers" "Complex numbers"
 { $subsection complex }
 "Complex numbers arise as solutions to quadratic equations whose graph does not intersect the " { $emphasis "x" } " axis. Their literal syntax is covered in " { $link "syntax-complex-numbers" } "."
 $nl
-"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero."
-$nl
 "Complex numbers can be taken apart:"
 { $subsection real-part }
 { $subsection imaginary-part }
 { $subsection >rect }
 "Complex numbers can be constructed from real numbers:"
 { $subsection rect> }
+{ $subsection "complex-numbers-zero" }
 { $see-also "syntax-complex-numbers" } ;
 HELP: complex
 { $class-description "The class of complex numbers with non-zero imaginary part." } ;

basis/math/complex/complex-tests.factor

@@ -6,8 +6,13 @@ IN: math.complex.tests
 [ C{ 0 1 } 1 rect> ] must-fail
 
 [ f ] [ C{ 5 12.5 } 5 = ] unit-test
-[ t ] [ C{ 1.0 2.0 } C{ 1 2 }  = ] unit-test
+[ f ] [ C{ 5 12.5 } 5 number= ] unit-test
+
+[ f ] [ C{ 1.0 2.0 } C{ 1 2 } = ] unit-test
+[ t ] [ C{ 1.0 2.0 } C{ 1 2 } number= ] unit-test
+
 [ f ] [ C{ 1.0 2.3 } C{ 1 2 } = ] unit-test
+[ f ] [ C{ 1.0 2.3 } C{ 1 2 } number= ] unit-test
 
 [ C{ 2 5 } ] [ 2 5  rect> ] unit-test
 [ 2 5 ] [ C{ 2 5 }  >rect ] unit-test
@@ -30,7 +35,7 @@ IN: math.complex.tests
 
 [ C{ 0 1 } ] [ C{ 0 1 } 1  * ] unit-test
 [ C{ 0 1 } ] [ 1 C{ 0 1 }  * ] unit-test
-[ C{ 0 1.0 } ] [ 1.0 C{ 0 1 }  * ] unit-test
+[ C{ 0.0 1.0 } ] [ 1.0 C{ 0 1 }  * ] unit-test
 [ -1 ] [ C{ 0 1 } C{ 0 1 }  * ] unit-test
 [ C{ 0 1 } ] [ 1 C{ 0 1 }  * ] unit-test
 [ C{ 0 1 } ] [ C{ 0 1 } 1  * ] unit-test
@@ -45,18 +50,18 @@ IN: math.complex.tests
 
 [ C{ -3 4 } ] [ C{ 3 -4 }  neg ] unit-test
 
-[ 5 ] [ C{ 3 4 } abs ] unit-test
+[ 5.0 ] [ C{ 3 4 } abs ] unit-test
-[ 5 ] [ -5.0 abs ] unit-test
+[ 5.0 ] [ -5.0 abs ] unit-test
 
 ! Make sure arguments are sane
-[ 0 ] [ 0 arg ] unit-test
+[ 0.0 ] [ 0 arg ] unit-test
-[ 0 ] [ 1 arg ] unit-test
+[ 0.0 ] [ 1 arg ] unit-test
 [ t ] [ -1 arg 3.14 3.15 between? ] unit-test
 [ t ] [ C{ 0 1 } arg 1.57 1.58 between? ] unit-test
 [ t ] [ C{ 0 -1 } arg -1.58 -1.57 between? ] unit-test
 
-[ 1 0 ] [ 1 >polar ] unit-test
+[ 1.0 0.0 ] [ 1 >polar ] unit-test
-[ 1 ] [ -1 >polar drop ] unit-test
+[ 1.0 ] [ -1 >polar drop ] unit-test
 [ t ] [ -1 >polar nip 3.14 3.15 between? ] unit-test
 
 ! I broke something

basis/math/complex/complex.factor

@@ -17,6 +17,14 @@ M: complex absq >rect [ sq ] bi@ + ;
     [ [ real-part ] bi@ ] 2keep
     [ imaginary-part ] bi@ ; inline
 
+M: complex hashcode*
+    nip >rect [ hashcode ] bi@ bitxor ;
+
+M: complex equal?
+    over complex? [
+        2>rect = [ = ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
+
 M: complex number=
     2>rect number= [ number= ] [ 2drop f ] if ;
 
@@ -36,8 +44,6 @@ M: complex abs absq >float fsqrt ;
 
 M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
 
-M: complex hashcode* nip >rect >fixnum swap >fixnum bitxor ;
-
 IN: syntax
 
 : C{ \ } [ first2 rect> ] parse-literal ; parsing

basis/math/functions/functions-docs.factor

@@ -106,7 +106,7 @@ HELP: (rect>)
 
 HELP: rect>
 { $values { "x" real } { "y" real } { "z" number } }
-{ $description "Creates a complex number from real and imaginary components." } ;
+{ $description "Creates a complex number from real and imaginary components. If " { $snippet "z" } " is an integer zero, this will simply output " { $snippet "x" } "." } ;
 
 HELP: >rect
 { $values { "z" number } { "x" real } { "y" real } }

basis/math/functions/functions-tests.factor

@@ -12,10 +12,11 @@ IN: math.functions.tests
 [ 0.25 ] [ 2.0 -2.0 fpow ] unit-test
 
 [ 4.0 ] [ 16 sqrt ] unit-test
-[ C{ 0 4.0 } ] [ -16 sqrt ] unit-test
+[ 2.0 ] [ 4.0 0.5 ^ ] unit-test
+[ C{ 0.0 4.0 } ] [ -16 sqrt ] unit-test
 
-[ 4.0 ] [ 2 2 ^ ] unit-test
+[ 4 ] [ 2 2 ^ ] unit-test
-[ 0.25 ] [ 2 -2 ^ ] unit-test
+[ 1/4 ] [ 2 -2 ^ ] unit-test
 [ t ] [ 2 0.5 ^ 2 ^ 2 2.00001 between? ] unit-test
 [ t ] [ e pi i* ^ real-part -1.0 = ] unit-test
 [ t ] [ e pi i* ^ imaginary-part -0.00001 0.00001 between? ] unit-test
@@ -27,6 +28,8 @@ IN: math.functions.tests
 [ 0 ] [ 0 3.0 ^ ] unit-test
 [ 0 ] [ 0 3 ^ ] unit-test
 
+[ 0.0 ] [ 1 log ] unit-test
+
 [ 1.0 ] [ 0 cosh ] unit-test
 [ 0.0 ] [ 1 acosh ] unit-test
             

basis/math/functions/functions.factor

@@ -7,7 +7,7 @@ IN: math.functions
 <PRIVATE
 
 : (rect>) ( x y -- z )
-    dup zero? [ drop ] [ <complex> ] if ; inline
+    dup 0 = [ drop ] [ <complex> ] if ; inline
 
 PRIVATE>
 
@@ -24,29 +24,57 @@ M: real sqrt
     >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
 
 : each-bit ( n quot: ( ? -- ) -- )
-    over 0 number= pick -1 number= or [
+    over 0 = pick -1 = or [
         2drop
     ] [
         2dup >r >r >r odd? r> call r> 2/ r> each-bit
     ] if ; inline recursive
 
-GENERIC: (^) ( x y -- z ) foldable
-
 : ^n ( z w -- z^w )
     1 swap [
         [ dupd * ] when >r sq r>
     ] each-bit nip ; inline
 
-M: integer (^)
+: integer^ ( x y -- z )
-    dup 0 < [ neg ^n recip ] [ ^n ] if ;
+    dup 0 > [ ^n ] [ neg ^n recip ] if ; inline
+
+: >rect ( z -- x y )
+    [ real-part ] [ imaginary-part ] bi ; inline
+
+: >float-rect ( z -- x y )
+    >rect [ >float ] bi@ ; inline
+
+: >polar ( z -- abs arg )
+    >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ;
+    inline
+
+: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
+
+: polar> ( abs arg -- z ) cis * ; inline
+
+: ^mag ( w abs arg -- magnitude )
+    >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
+    inline
+
+: ^theta ( w abs arg -- theta )
+    >r >r >float-rect r> flog * swap r> * + ; inline
+
+: ^complex ( x y -- z )
+    swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline
+
+: real^? ( x y -- ? )
+    2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline
+
+: 0^ ( x -- z )
+    dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
 
 : ^ ( x y -- z )
-    over zero? [
+    {
-        dup zero?
+        { [ over zero? ] [ nip 0^ ] }
-        [ 2drop 0.0 0.0 / ] [ 0 < [ drop 1.0 0.0 / ] when ] if
+        { [ dup integer? ] [ integer^ ] }
-    ] [
+        { [ 2dup real^? ] [ fpow ] }
-        (^)
+        [ ^complex ]
-    ] if ; inline
+    } cond ;
 
 : (^mod) ( n x y -- z )
     1 swap [
@@ -98,42 +126,27 @@ M: real absq sq ;
         [ ~abs ]
     } cond ;
 
-: >rect ( z -- x y ) dup real-part swap imaginary-part ; inline
-
 : conjugate ( z -- z* ) >rect neg rect> ; inline
 
-: >float-rect ( z -- x y )
-    >rect swap >float swap >float ; inline
-
 : arg ( z -- arg ) >float-rect swap fatan2 ; inline
 
-: >polar ( z -- abs arg )
-    >float-rect [ [ sq ] bi@ + fsqrt ] 2keep swap fatan2 ;
-    inline
-
-: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
-
-: polar> ( abs arg -- z ) cis * ; inline
-
-: ^mag ( w abs arg -- magnitude )
-    >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
-    inline
-
-: ^theta ( w abs arg -- theta )
-    >r >r >float-rect r> flog * swap r> * + ; inline
-
-M: number (^)
-    swap >polar 3dup ^theta >r ^mag r> polar> ;
-
 : [-1,1]? ( x -- ? )
     dup complex? [ drop f ] [ abs 1 <= ] if ; inline
 
 : >=1? ( x -- ? )
     dup complex? [ drop f ] [ 1 >= ] if ; inline
 
-: exp ( x -- y ) >rect swap fexp swap polar> ; inline
+GENERIC: exp ( x -- y )
 
-: log ( x -- y ) >polar swap flog swap rect> ; inline
+M: real exp fexp ;
+
+M: complex exp >rect swap fexp swap polar> ;
+
+GENERIC: log ( x -- y )
+
+M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ;
+
+M: complex log >polar swap flog swap rect> ;
 
 : cos ( x -- y )
     dup complex? [

basis/math/geometry/rect/rect-docs.factor

@@ -17,11 +17,6 @@ HELP: <rect> ( loc dim -- rect )
 
 { <zero-rect> <rect> <extent-rect> } related-words
 
-HELP: set-rect-dim ( dim rect -- )
-{ $values { "dim" "a pair of integers" } { "rect" rect } }
-{ $description "Modifies the dimensions of a rectangle." }
-{ $side-effects "rect" } ;
-
 HELP: rect-bounds
 { $values { "rect" rect } { "loc" "a pair of integers" } { "dim" "a pair of integers" } }
 { $description "Outputs the location and dimensions of a rectangle." } ;

basis/math/geometry/rect/rect.factor

@@ -7,6 +7,9 @@ IN: math.geometry.rect
 
 TUPLE: rect loc dim ;
 
+GENERIC: rect-loc ( obj -- loc )
+GENERIC: rect-dim ( obj -- dim )
+
 : init-rect ( rect -- rect ) { 0 0 } clone >>loc { 0 0 } clone >>dim ;
 
 : <rect> ( loc dim -- rect ) rect boa ;
@@ -17,6 +20,10 @@ M: array rect-loc ;
 
 M: array rect-dim drop { 0 0 } ;
 
+M: rect rect-loc loc>> ;
+
+M: rect rect-dim dim>> ;
+
 : rect-bounds ( rect -- loc dim ) dup rect-loc swap rect-dim ;
 
 : rect-extent ( rect -- loc ext ) rect-bounds over v+ ;

basis/math/intervals/intervals-tests.factor

@@ -60,11 +60,11 @@ IN: math.intervals.tests
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -0.5 0.5 [a,b] interval* -1 1 [a,b] =
+    1 2 [a,b] -0.5 0.5 [a,b] interval* -1.0 1.0 [a,b] =
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -0.5 0.5 (a,b] interval* -1 1 (a,b] =
+    1 2 [a,b] -0.5 0.5 (a,b] interval* -1.0 1.0 (a,b] =
 ] unit-test
 
 [ t ] [
@@ -131,7 +131,7 @@ IN: math.intervals.tests
 
 "math.ratios.private" vocab [
     [ t ] [
-        -1 1 (a,b) 0.5 1 (a,b) interval/ -2 2 (a,b) =
+        -1 1 (a,b) 0.5 1 (a,b) interval/ -2.0 2.0 (a,b) =
     ] unit-test
 ] when
 

basis/math/ratios/ratios-tests.factor

@@ -81,8 +81,8 @@ unit-test
 [ -1/2 ] [ 1/2 1- ] unit-test
 [ 3/2 ] [ 1/2 1+ ] unit-test
 
-[ 1 ] [ 0.5 1/2 + ] unit-test
+[ 1.0 ] [ 0.5 1/2 + ] unit-test
-[ 1 ] [ 1/2 0.5 + ] unit-test
+[ 1.0 ] [ 1/2 0.5 + ] unit-test
 
 [ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
 [ 268435456 ] [ -268435456 >fixnum -1 / ] unit-test

basis/math/ratios/ratios.factor

@@ -30,6 +30,14 @@ M: integer /
         2dup gcd nip tuck /i >r /i r> fraction>
     ] if ;
 
+M: ratio hashcode*
+    nip >fraction [ hashcode ] bi@ bitxor ;
+
+M: ratio equal?
+    over ratio? [
+        2>fraction = [ = ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
+
 M: ratio number=
     2>fraction number= [ number= ] [ 2drop f ] if ;
 

basis/mirrors/mirrors-tests.factor

@@ -15,7 +15,7 @@ C: <foo> foo
 [ f f ] [ "hi" 1 2 <foo> <mirror> at* ] unit-test
 
 [ 3 ] [
-    3 "baz" 1 2 <foo> [ <mirror> set-at ] keep foo-baz
+    3 "baz" 1 2 <foo> [ <mirror> set-at ] keep baz>>
 ] unit-test
 
 [ 3 "hi" 1 2 <foo> <mirror> set-at ] must-fail

basis/models/compose/compose-tests.factor

@@ -1,6 +1,6 @@
-IN: models.compose.tests
 USING: arrays generic kernel math models namespaces sequences assocs
-tools.test models.compose ;
+tools.test models.compose accessors ;
+IN: models.compose.tests
 
 ! Test compose
 [ ] [
@@ -11,14 +11,14 @@ tools.test models.compose ;
 
 [ ] [ "c" get activate-model ] unit-test
 
-[ { 1 2 } ] [ "c" get model-value ] unit-test
+[ { 1 2 } ] [ "c" get value>> ] unit-test
 
 [ ] [ 3 "b" get set-model ] unit-test
 
-[ { 1 3 } ] [ "c" get model-value ] unit-test
+[ { 1 3 } ] [ "c" get value>> ] unit-test
 
 [ ] [ { 4 5 } "c" get set-model ] unit-test
 
-[ { 4 5 } ] [ "c" get model-value ] unit-test
+[ { 4 5 } ] [ "c" get value>> ] unit-test
 
 [ ] [ "c" get deactivate-model ] unit-test

basis/models/compose/compose.factor

@@ -18,12 +18,12 @@ TUPLE: compose < model ;
 
 M: compose model-changed
     nip
-    [ [ model-value ] composed-value ] keep set-model ;
+    [ [ value>> ] composed-value ] keep set-model ;
 
 M: compose model-activated dup model-changed ;
 
 M: compose update-model
-    dup model-value swap [ set-model ] set-composed-value ;
+    dup value>> swap [ set-model ] set-composed-value ;
 
 M: compose range-value
     [ range-value ] composed-value ;

basis/models/filter/filter-tests.factor

@@ -1,18 +1,18 @@
-IN: models.filter.tests
 USING: arrays generic kernel math models namespaces sequences assocs
-tools.test models.filter ;
+tools.test models.filter accessors ;
+IN: models.filter.tests
 
 ! Test multiple filters
 3 <model> "x" set
 "x" get [ 2 * ] <filter> dup "z" set
 [ 1+ ] <filter> "y" set
 [ ] [ "y" get activate-model ] unit-test
-[ t ] [ "z" get "x" get model-connections memq? ] unit-test
+[ t ] [ "z" get "x" get connections>> memq? ] unit-test
-[ 7 ] [ "y" get model-value ] unit-test
+[ 7 ] [ "y" get value>> ] unit-test
 [ ] [ 4 "x" get set-model ] unit-test
-[ 9 ] [ "y" get model-value ] unit-test
+[ 9 ] [ "y" get value>> ] unit-test
 [ ] [ "y" get deactivate-model ] unit-test
-[ f ] [ "z" get "x" get model-connections memq? ] unit-test
+[ f ] [ "z" get "x" get connections>> memq? ] unit-test
 
 3 <model> "x" set
 "x" get [ sq ] <filter> "y" set
@@ -20,5 +20,5 @@ tools.test models.filter ;
 4 "x" get set-model
 
 "y" get activate-model
-[ 16 ] [ "y" get model-value ] unit-test
+[ 16 ] [ "y" get value>> ] unit-test
 "y" get deactivate-model

basis/models/history/history-tests.factor

@@ -1,37 +1,37 @@
-IN: models.history.tests
 USING: arrays generic kernel math models namespaces sequences assocs
-tools.test models.history ;
+tools.test models.history accessors ;
+IN: models.history.tests
 
 f <history> "history" set
 
 "history" get add-history
 
-[ t ] [ "history" get history-back empty? ] unit-test
+[ t ] [ "history" get back>> empty? ] unit-test
-[ t ] [ "history" get history-forward empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
 
 "history" get add-history
 3 "history" get set-model
 
-[ t ] [ "history" get history-back empty? ] unit-test
+[ t ] [ "history" get back>> empty? ] unit-test
-[ t ] [ "history" get history-forward empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
 
 "history" get add-history
 4 "history" get set-model
 
-[ f ] [ "history" get history-back empty? ] unit-test
+[ f ] [ "history" get back>> empty? ] unit-test
-[ t ] [ "history" get history-forward empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
 
 "history" get go-back
 
-[ 3 ] [ "history" get model-value ] unit-test
+[ 3 ] [ "history" get value>> ] unit-test
 
-[ t ] [ "history" get history-back empty? ] unit-test
+[ t ] [ "history" get back>> empty? ] unit-test
-[ f ] [ "history" get history-forward empty? ] unit-test
+[ f ] [ "history" get forward>> empty? ] unit-test
 
 "history" get go-forward
 
-[ 4 ] [ "history" get model-value ] unit-test
+[ 4 ] [ "history" get value>> ] unit-test
 
-[ f ] [ "history" get history-back empty? ] unit-test
+[ f ] [ "history" get back>> empty? ] unit-test
-[ t ] [ "history" get history-forward empty? ] unit-test
+[ t ] [ "history" get forward>> empty? ] unit-test
 

basis/models/mapping/mapping-tests.factor

@@ -1,6 +1,6 @@
-IN: models.mapping.tests
 USING: arrays generic kernel math models namespaces sequences assocs
-tools.test models.mapping ;
+tools.test models.mapping accessors ;
+IN: models.mapping.tests
 
 ! Test mapping
 [ ] [
@@ -14,7 +14,7 @@ tools.test models.mapping ;
 [ ] [ "m" get activate-model ] unit-test
 
 [ H{ { "one" 1 } { "two" 2 } } ] [
-    "m" get model-value
+    "m" get value>>
 ] unit-test
 
 [ ] [
@@ -23,12 +23,12 @@ tools.test models.mapping ;
 ] unit-test
 
 [ H{ { "one" 3 } { "two" 4 } } ] [
-    "m" get model-value
+    "m" get value>>
 ] unit-test
 
 [ H{ { "one" 5 } { "two" 4 } } ] [
-    5 "one" "m" get mapping-assoc at set-model
+    5 "one" "m" get assoc>> at set-model
-    "m" get model-value
+    "m" get value>>
 ] unit-test
 
 [ ] [ "m" get deactivate-model ] unit-test

basis/models/models-tests.factor

@@ -1,13 +1,12 @@
-IN: models.tests
 USING: arrays generic kernel math models models.compose
-namespaces sequences assocs
+namespaces sequences assocs accessors tools.test ;
-tools.test ;
+IN: models.tests
 
 TUPLE: model-tester hit? ;
 
 : <model-tester> model-tester new ;
 
-M: model-tester model-changed nip t swap set-model-tester-hit? ;
+M: model-tester model-changed nip t >>hit? drop ;
 
 [ T{ model-tester f t } ]
 [
@@ -20,7 +19,7 @@ M: model-tester model-changed nip t swap set-model-tester-hit? ;
 "model-a" get "model-b" get 2array <compose> "model-c" set
 
 "model-c" get activate-model
-[ { 3 4 } ] [ "model-c" get model-value  ] unit-test
+[ { 3 4 } ] [ "model-c" get value>>  ] unit-test
 "model-c" get deactivate-model
 
 T{ model-tester f f } "tester" set
@@ -30,5 +29,5 @@ T{ model-tester f f } "tester" set
     "tester" get "model-c" get add-connection
     6 "model-a" get set-model
     "tester" get
-    "model-c" get model-value
+    "model-c" get value>>
 ] unit-test

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
+    -rot dupd call
-    [ r> 2drop ]
+    [ 2drop ]
-    [ r> " " make throw ]
+    [ swap " " make throw ]
     if ; inline
 
 : gl-extensions ( -- seq )

basis/stack-checker/stack-checker-tests.factor

@@ -148,7 +148,7 @@ M: fixnum potential-hang dup [ potential-hang ] when ;
 
 TUPLE: funny-cons car cdr ;
 GENERIC: iterate ( obj -- )
-M: funny-cons iterate funny-cons-cdr iterate ;
+M: funny-cons iterate cdr>> iterate ;
 M: f iterate drop ;
 M: real iterate drop ;
 

basis/tools/deploy/shaker/shaker.factor

@@ -246,7 +246,7 @@ IN: tools.deploy.shaker
                 word
             } %
 
-            { } { "optimizer.math.partial" } strip-vocab-globals %
+            { } { "math.partial-dispatch" } strip-vocab-globals %
         ] when
 
         strip-prettyprint? [

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

basis/ui/cocoa/cocoa.factor

@@ -24,10 +24,10 @@ TUPLE: pasteboard handle ;
 C: <pasteboard> pasteboard
 
 M: pasteboard clipboard-contents
-    pasteboard-handle pasteboard-string ;
+    handle>> pasteboard-string ;
 
 M: pasteboard set-clipboard-contents
-    pasteboard-handle set-pasteboard-string ;
+    handle>> set-pasteboard-string ;
 
 : init-clipboard ( -- )
     NSPasteboard -> generalPasteboard <pasteboard>
@@ -44,29 +44,29 @@ M: pasteboard set-clipboard-contents
         dup install-window-delegate
         over -> release
         <handle>
-    ] keep set-world-handle ;
+    ] keep (>>handle) ;
 
 M: cocoa-ui-backend set-title ( string world -- )
-    world-handle handle-window swap <NSString> -> setTitle: ;
+    handle>> window>> swap <NSString> -> setTitle: ;
 
 : enter-fullscreen ( world -- )
-    world-handle handle-view
+    handle>> view>>
     NSScreen -> mainScreen
     f -> enterFullScreenMode:withOptions:
     drop ;
 
 : exit-fullscreen ( world -- )
-    world-handle handle-view f -> exitFullScreenModeWithOptions: ;
+    handle>> view>> f -> exitFullScreenModeWithOptions: ;
 
 M: cocoa-ui-backend set-fullscreen* ( ? world -- )
     swap [ enter-fullscreen ] [ exit-fullscreen ] if ;
 
 M: cocoa-ui-backend fullscreen* ( world -- ? )
-    world-handle handle-view -> isInFullScreenMode zero? not ;
+    handle>> view>> -> isInFullScreenMode zero? not ;
 
 : auto-position ( world -- )
     dup window-loc>> { 0 0 } = [
-        world-handle handle-window -> center
+        handle>> window>> -> center
     ] [
         drop
     ] if ;
@@ -74,29 +74,29 @@ M: cocoa-ui-backend fullscreen* ( world -- ? )
 M: cocoa-ui-backend (open-window) ( world -- )
     dup gadget-window
     dup auto-position
-    world-handle handle-window f -> makeKeyAndOrderFront: ;
+    handle>> window>> f -> makeKeyAndOrderFront: ;
 
 M: cocoa-ui-backend (close-window) ( handle -- )
-    handle-window -> release ;
+    window>> -> release ;
 
 M: cocoa-ui-backend close-window ( gadget -- )
     find-world [
-        world-handle [
+        handle>> [
-            handle-window f -> performClose:
+            window>> f -> performClose:
         ] when*
     ] when* ;
 
 M: cocoa-ui-backend raise-window* ( world -- )
-    world-handle [
+    handle>> [
-        handle-window dup f -> orderFront: -> makeKeyWindow
+        window>> dup f -> orderFront: -> makeKeyWindow
         NSApp 1 -> activateIgnoringOtherApps:
     ] when* ;
 
 M: cocoa-ui-backend select-gl-context ( handle -- )
-    handle-view -> openGLContext -> makeCurrentContext ;
+    view>> -> openGLContext -> makeCurrentContext ;
 
 M: cocoa-ui-backend flush-gl-context ( handle -- )
-    handle-view -> openGLContext -> flushBuffer ;
+    view>> -> openGLContext -> flushBuffer ;
 
 M: cocoa-ui-backend beep ( -- )
     NSBeep ;

basis/ui/gadgets/borders/borders.factor

@@ -41,7 +41,7 @@ M: border pref-dim*
 
 M: border layout*
     dup border-child-rect swap gadget-child
-    over loc>> over set-rect-loc
+    over loc>> >>loc
     swap dim>> swap (>>dim) ;
 
 M: border focusable-child*

basis/ui/gadgets/buttons/buttons-tests.factor

@@ -1,6 +1,7 @@
-IN: ui.gadgets.buttons.tests
 USING: ui.commands ui.gadgets.buttons ui.gadgets.labels
-ui.gadgets tools.test namespaces sequences kernel models ;
+ui.gadgets tools.test namespaces sequences kernel models
+accessors ;
+IN: ui.gadgets.buttons.tests
 
 TUPLE: foo-gadget ;
 
@@ -15,7 +16,7 @@ TUPLE: foo-gadget ;
 
 T{ foo-gadget } <toolbar> "t" set
 
-[ 2 ] [ "t" get gadget-children length ] unit-test
+[ 2 ] [ "t" get children>> length ] unit-test
 [ "Foo A" ] [ "t" get gadget-child gadget-child label-string ] unit-test
 
 [ ] [
@@ -34,7 +35,7 @@ T{ foo-gadget } <toolbar> "t" set
 \ <checkbox> must-infer
 
 [ 0 ] [
-    "religion" get gadget-child radio-control-value
+    "religion" get gadget-child value>>
 ] unit-test
 
 [ 2 ] [

basis/ui/gadgets/buttons/buttons.factor

@@ -148,7 +148,7 @@ TUPLE: checkbox < button ;
         align-left ;
 
 M: checkbox model-changed
-    swap model-value over (>>selected?) relayout-1 ;
+    swap value>> over (>>selected?) relayout-1 ;
 
 TUPLE: radio-paint color ;
 
@@ -187,7 +187,7 @@ TUPLE: radio-control < button value ;
         align-left ; inline
 
 M: radio-control model-changed
-    swap model-value
+    swap value>>
     over value>> =
     over (>>selected?)
     relayout-1 ;

basis/ui/gadgets/canvas/canvas-tests.factor

@@ -0,0 +1,4 @@
+IN: ui.gadgets.canvas.tests
+USING: ui.gadgets.canvas tools.test kernel ;
+
+{ 1 0 } [ [ drop ] draw-canvas ] must-infer-as

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
+    [ find-gl-context ]
-    dup canvas-dlist [ delete-dlist ] when*
+    [ dlist>> [ delete-dlist ] when* ]
-    f swap set-canvas-dlist ;
+    [ f >>dlist drop ] tri ;
 
 : make-canvas-dlist ( canvas quot -- dlist )
-    over >r GL_COMPILE swap make-dlist dup r>
+    [ drop ] [ GL_COMPILE swap make-dlist ] 2bi
-    set-canvas-dlist ;
+    [ >>dlist drop ] keep ; inline
 
 : cache-canvas-dlist ( canvas quot -- dlist )
-    over canvas-dlist dup
+    over dlist>> dup
     [ 2nip ] [ drop make-canvas-dlist ] if ; inline
 
 : draw-canvas ( canvas quot -- )

basis/ui/gadgets/editors/editors-tests.factor

@@ -2,6 +2,7 @@ USING: accessors ui.gadgets.editors tools.test kernel io
 io.streams.plain definitions namespaces ui.gadgets
 ui.gadgets.grids prettyprint documents ui.gestures tools.test.ui
 models ;
+IN: ui.gadgets.editors.tests
 
 [ "foo bar" ] [
     <editor> "editor" set
@@ -34,7 +35,7 @@ models ;
     <editor> "editor" set
     "editor" get [
         "bar\nbaz quux" "editor" get set-editor-string
-        { 0 3 } "editor" get editor-caret set-model
+        { 0 3 } "editor" get caret>> set-model
         "editor" get select-word
         "editor" get gadget-selection
     ] with-grafted-gadget
@@ -45,5 +46,5 @@ models ;
 "hello" <model> <field> "field" set
 
 "field" get [
-    [ "hello" ] [ "field" get field-model>> model-value ] unit-test
+    [ "hello" ] [ "field" get field-model>> value>> ] unit-test
 ] with-grafted-gadget

basis/ui/gadgets/gadgets-tests.factor

@@ -1,8 +1,8 @@
-IN: ui.gadgets.tests
 USING: accessors ui.gadgets ui.gadgets.packs ui.gadgets.worlds
 tools.test namespaces models kernel dlists deques math sets
 math.parser ui sequences hashtables assocs io arrays prettyprint
 io.streams.string math.geometry.rect ;
+IN: ui.gadgets.tests
 
 [ { 300 300 } ]
 [
@@ -14,24 +14,24 @@ io.streams.string math.geometry.rect ;
     "b" get "c" get swap add-gadget drop
 
     ! position a and b
-    { 100 200 } "a" get set-rect-loc
+    "a" get { 100 200 } >>loc drop
-    { 200 100 } "b" get set-rect-loc
+    "b" get { 200 100 } >>loc drop
 
     ! give c a loc, it doesn't matter
-    { -1000 23 } "c" get set-rect-loc
+    "c" get { -1000 23 } >>loc drop
 
     ! what is the location of a inside c?
     "a" get "c" get relative-loc
 ] unit-test
 
 <gadget> "g1" set
-{ 10 10 } "g1" get set-rect-loc
+"g1" get { 10 10 } >>loc
-{ 30 30 } "g1" get set-rect-dim
+         { 30 30 } >>dim drop
 <gadget> "g2" set
-{ 20 20 } "g2" get set-rect-loc
+"g2" get { 20 20 } >>loc
-{ 50 500 } "g2" get set-rect-dim
+         { 50 500 } >>dim drop
 <gadget> "g3" set
-{ 100 200 } "g3" get set-rect-dim
+"g3" get { 100 200 } >>dim drop
 
 "g1" get "g2" get swap add-gadget drop
 "g2" get "g3" get swap add-gadget drop
@@ -47,15 +47,15 @@ io.streams.string math.geometry.rect ;
 [ { 100 200 } ] [ "g3" get screen-rect rect-dim ] unit-test
 
 <gadget> "g1" set
-{ 300 300 } "g1" get set-rect-dim
+"g1" get { 300 300 } >>dim drop
 <gadget> "g2" set
 "g2" get "g1" get swap add-gadget drop
-{ 20 20 } "g2" get set-rect-loc
+"g2" get { 20 20 } >>loc
-{ 20 20 } "g2" get set-rect-dim
+         { 20 20 } >>dim drop
 <gadget> "g3" set
 "g3" get "g1" get swap add-gadget drop
-{ 100 100 } "g3" get set-rect-loc
+"g3" get { 100 100 } >>loc
-{ 20 20 } "g3" get set-rect-dim
+         { 20 20 } >>dim drop
 
 [ t ] [ { 30 30 } "g2" get inside? ] unit-test
 
@@ -67,8 +67,8 @@ io.streams.string math.geometry.rect ;
 
 <gadget> "g4" set
 "g4" get "g2" get swap add-gadget drop
-{ 5 5 } "g4" get set-rect-loc
+"g4" get { 5 5 } >>loc
-{ 1 1 } "g4" get set-rect-dim
+         { 1 1 } >>dim drop
 
 [ t ] [ { 25 25 } "g1" get pick-up "g4" get eq? ] unit-test
 
@@ -78,12 +78,10 @@ TUPLE: mock-gadget < gadget graft-called ungraft-called ;
     mock-gadget new-gadget 0 >>graft-called 0 >>ungraft-called ;
 
 M: mock-gadget graft*
-    dup mock-gadget-graft-called 1+
+    [ 1+ ] change-graft-called drop ;
-    swap set-mock-gadget-graft-called ;
 
 M: mock-gadget ungraft*
-    dup mock-gadget-ungraft-called 1+
+    [ 1+ ] change-ungraft-called drop ;
-    swap set-mock-gadget-ungraft-called ;
 
 ! We can't print to output-stream here because that might be a pane
 ! stream, and our graft-queue rebinding here would be captured
@@ -100,35 +98,35 @@ M: mock-gadget ungraft*
         <mock-gadget> "g" set
         [ ] [ "g" get queue-graft ] unit-test
         [ f ] [ graft-queue deque-empty? ] unit-test
-        [ { f t } ] [ "g" get gadget-graft-state ] unit-test
+        [ { f t } ] [ "g" get graft-state>> ] unit-test
         [ ] [ "g" get graft-later ] unit-test
-        [ { f t } ] [ "g" get gadget-graft-state ] unit-test
+        [ { f t } ] [ "g" get graft-state>> ] unit-test
         [ ] [ "g" get ungraft-later ] unit-test
-        [ { f f } ] [ "g" get gadget-graft-state ] unit-test
+        [ { f f } ] [ "g" get graft-state>> ] unit-test
         [ t ] [ graft-queue deque-empty? ] unit-test
         [ ] [ "g" get ungraft-later ] unit-test
         [ ] [ "g" get graft-later ] unit-test
         [ ] [ notify-queued ] unit-test
-        [ { t t } ] [ "g" get gadget-graft-state ] unit-test
+        [ { t t } ] [ "g" get graft-state>> ] unit-test
         [ t ] [ graft-queue deque-empty? ] unit-test
         [ ] [ "g" get graft-later ] unit-test
-        [ 1 ] [ "g" get mock-gadget-graft-called ] unit-test
+        [ 1 ] [ "g" get graft-called>> ] unit-test
         [ ] [ "g" get ungraft-later ] unit-test
-        [ { t f } ] [ "g" get gadget-graft-state ] unit-test
+        [ { t f } ] [ "g" get graft-state>> ] unit-test
         [ ] [ notify-queued ] unit-test
-        [ 1 ] [ "g" get mock-gadget-ungraft-called ] unit-test
+        [ 1 ] [ "g" get ungraft-called>> ] unit-test
-        [ { f f } ] [ "g" get gadget-graft-state ] unit-test
+        [ { f f } ] [ "g" get graft-state>> ] unit-test
     ] with-variable
 
     : add-some-children
         3 [
-            <mock-gadget> over <model> over set-gadget-model
+            <mock-gadget> over <model> >>model
             dup "g" get swap add-gadget drop
             swap 1+ number>string set
         ] each ;
 
     : status-flags
-        { "g" "1" "2" "3" } [ get gadget-graft-state ] map prune ;
+        { "g" "1" "2" "3" } [ get graft-state>> ] map prune ;
 
     : notify-combo ( ? ? -- )
         nl "===== Combo: " write 2dup 2array . nl
@@ -140,12 +138,12 @@ M: mock-gadget ungraft*
             [ V{ { f t } } ] [ status-flags ] unit-test
             dup [ [ ] [ notify-queued ] unit-test ] when
             [ ] [ "g" get clear-gadget ] unit-test
-            [ [ 1 ] [ graft-queue dlist-length ] unit-test ] unless
+            [ [ 1 ] [ graft-queue length>> ] unit-test ] unless
             [ [ ] [ notify-queued ] unit-test ] when
             [ ] [ add-some-children ] unit-test
-            [ { f t } ] [ "1" get gadget-graft-state ] unit-test
+            [ { f t } ] [ "1" get graft-state>> ] unit-test
-            [ { f t } ] [ "2" get gadget-graft-state ] unit-test
+            [ { f t } ] [ "2" get graft-state>> ] unit-test
-            [ { f t } ] [ "3" get gadget-graft-state ] unit-test
+            [ { f t } ] [ "3" get graft-state>> ] unit-test
             [ ] [ graft-queue [ "x" print notify ] slurp-deque ] unit-test
             [ ] [ notify-queued ] unit-test
             [ V{ { t t } } ] [ status-flags ] unit-test

basis/ui/gadgets/grids/grids-tests.factor

@@ -1,10 +1,10 @@
 USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
-namespaces math.geometry.rect ;
+namespaces math.geometry.rect accessors ;
 IN: ui.gadgets.grids.tests
 
 [ { 0 0 } ] [ { } <grid> pref-dim ] unit-test
 
-: 100x100 <gadget> { 100 100 } over set-rect-dim ;
+: 100x100 <gadget> { 100 100 } >>dim ;
 
 [ { 100 100 } ] [
     100x100
@@ -38,7 +38,7 @@ IN: ui.gadgets.grids.tests
     100x100 dup "a" set
     100x100 dup "b" set
     2array 1array <grid>
-    { 10 10 } over set-grid-gap
+    { 10 10 } >>gap
     dup prefer
     dup layout
     rect-dim

basis/ui/gadgets/grids/grids.factor

@@ -62,7 +62,7 @@ M: grid pref-dim*
 : position-grid ( grid horiz vert -- )
     pick >r
     >r over r> grid-positions >r grid-positions r>
-    pair-up r> [ set-rect-loc ] do-grid ;
+    pair-up r> [ (>>loc) ] do-grid ;
 
 : resize-grid ( grid horiz vert -- )
     pick fill?>> [

basis/ui/gadgets/incremental/incremental.factor

@@ -37,8 +37,8 @@ M: incremental pref-dim*
     [ next-cursor ] keep (>>cursor) ;
 
 : incremental-loc ( gadget incremental -- )
-    dup cursor>> swap orientation>> v*
+    [ cursor>> ] [ orientation>> ] bi v*
-    swap set-rect-loc ;
+    >>loc drop ;
 
 : prefer-incremental ( gadget -- )
     dup forget-pref-dim dup pref-dim >>dim drop ;

basis/ui/gadgets/labels/labels.factor

@@ -43,7 +43,7 @@ M: label gadget-text* label-string % ;
 TUPLE: label-control < label ;
 
 M: label-control model-changed
-    swap model-value over set-label-string relayout ;
+    swap value>> over set-label-string relayout ;
 
 : <label-control> ( model -- gadget )
     "" label-control new-label

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 ;

basis/ui/gadgets/menus/menus.factor

@@ -14,7 +14,7 @@ TUPLE: menu-glass < gadget ;
 
 : <menu-glass> ( menu world -- glass )
     menu-glass new-gadget
-    >r over menu-loc over set-rect-loc r>
+    >r over menu-loc >>loc r>
     [ swap add-gadget drop ] keep ;
 
 M: menu-glass layout* gadget-child prefer ;

basis/ui/gadgets/packs/packs.factor

@@ -32,7 +32,7 @@ TUPLE: pack < gadget
 : pack-layout ( pack sizes -- )
     round-dims over children>>
     >r dupd packed-dims r> 2dup [ (>>dim) ] 2each
-    >r packed-locs r> [ set-rect-loc ] 2each ;
+    >r packed-locs r> [ (>>loc) ] 2each ;
 
 : <pack> ( orientation -- pack )
     pack new-gadget

basis/ui/gadgets/panes/panes-tests.factor

@@ -1,11 +1,11 @@
-IN: ui.gadgets.panes.tests
 USING: alien ui.gadgets.panes ui.gadgets namespaces
 kernel sequences io io.styles io.streams.string tools.test
 prettyprint definitions help help.syntax help.markup
 help.stylesheet splitting tools.test.ui models math summary
-inspector ;
+inspector accessors ;
+IN: ui.gadgets.panes.tests
 
-: #children "pane" get gadget-children length ;
+: #children "pane" get children>> length ;
 
 [ ] [ <pane> "pane" set ] unit-test
 

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -69,4 +69,4 @@ M: paragraph pref-dim*
     [ 2drop ] do-wrap ;
 
 M: paragraph layout*
-    [ swap dup prefer set-rect-loc ] do-wrap drop ;
+    [ swap dup prefer (>>loc) ] do-wrap drop ;

basis/ui/gadgets/presentations/presentations-tests.factor

@@ -1,7 +1,7 @@
-IN: ui.gadgets.presentations.tests
 USING: math ui.gadgets.presentations ui.gadgets tools.test
 prettyprint ui.gadgets.buttons io io.streams.string kernel
-classes.tuple ;
+classes.tuple accessors ;
+IN: ui.gadgets.presentations.tests
 
 [ t ] [
     "Hi" \ + <presentation> gadget?
@@ -9,6 +9,6 @@ classes.tuple ;
 
 [ "+" ] [
     [
-        \ + f \ pprint <command-button> dup button-quot call
+        \ + f \ pprint <command-button> dup quot>> call
     ] with-string-writer
 ] unit-test

basis/ui/gadgets/scrollers/scrollers-tests.factor

@@ -1,9 +1,9 @@
-IN: ui.gadgets.scrollers.tests
 USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
 kernel models models.compose models.range ui.gadgets.viewports
 ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
 ui.gadgets.sliders math math.vectors arrays sequences
-tools.test.ui math.geometry.rect ;
+tools.test.ui math.geometry.rect accessors ;
+IN: ui.gadgets.scrollers.tests
 
 [ ] [
     <gadget> "g" set
@@ -12,11 +12,11 @@ tools.test.ui math.geometry.rect ;
 
 [ { 100 200 } ] [
     { 100 200 } "g" get scroll>rect
-    "s" get scroller-follows rect-loc
+    "s" get follows>> rect-loc
 ] unit-test
 
 [ ] [ "s" get scroll>bottom ] unit-test
-[ t ] [ "s" get scroller-follows ] unit-test
+[ t ] [ "s" get follows>> ] unit-test
 
 [ ] [
     <gadget> dup "g" set
@@ -25,46 +25,46 @@ tools.test.ui math.geometry.rect ;
 ] unit-test
 
 "v" get [
-    [ { 10 20 } ] [ "v" get gadget-model range-value ] unit-test
+    [ { 10 20 } ] [ "v" get model>> range-value ] unit-test
 
     [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
 ] with-grafted-gadget
 
 [ ] [
-    <gadget> { 100 100 } over set-rect-dim
+    <gadget> { 100 100 } >>dim
     dup "g" set <scroller> "s" set
 ] unit-test
 
-[ ] [ { 50 50 } "s" get set-rect-dim ] unit-test
+[ ] [ "s" get { 50 50 } >>dim drop ] unit-test
 
 [ ] [ "s" get layout ] unit-test
 
 "s" get [
-    [ { 34 34 } ] [ "s" get scroller-viewport rect-dim ] unit-test
+    [ { 34 34 } ] [ "s" get viewport>> rect-dim ] unit-test
 
-    [ { 106 106 } ] [ "s" get scroller-viewport viewport-dim ] unit-test
+    [ { 106 106 } ] [ "s" get viewport>> viewport-dim ] unit-test
 
     [ ] [ { 0 0 } "s" get scroll ] unit-test
 
-    [ { 0 0 } ] [ "s" get gadget-model range-min-value ] unit-test
+    [ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
 
-    [ { 106 106 } ] [ "s" get gadget-model range-max-value ] unit-test
+    [ { 106 106 } ] [ "s" get model>> range-max-value ] unit-test
 
     [ ] [ { 10 20 } "s" get scroll ] unit-test
 
-    [ { 10 20 } ] [ "s" get gadget-model range-value ] unit-test
+    [ { 10 20 } ] [ "s" get model>> range-value ] unit-test
 
-    [ { 10 20 } ] [ "s" get scroller-viewport gadget-model range-value ] unit-test
+    [ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test
 
     [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
 ] with-grafted-gadget
 
-<gadget> { 600 400 } over set-rect-dim "g1" set
+<gadget> { 600 400 } >>dim "g1" set
-<gadget> { 600 10 } over set-rect-dim "g2" set
+<gadget> { 600 10 } >>dim "g2" set
 "g2" get "g1" get swap add-gadget drop
 
 "g1" get <scroller>
-{ 300 300 } over set-rect-dim
+{ 300 300 } >>dim
 dup layout
 "s" set
 
@@ -80,9 +80,9 @@ dup layout
 [ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
 
 [ t ] [ "l" get find-scroller "s" get eq? ] unit-test
-[ t ] [ "l" get dup find-scroller scroller-viewport swap child? ] unit-test
+[ t ] [ "l" get dup find-scroller viewport>> swap child? ] unit-test
 [ t ] [ "l" get find-scroller* "s" get eq? ] unit-test
-[ f ] [ "s" get scroller-viewport find-scroller* ] unit-test
+[ f ] [ "s" get viewport>> find-scroller* ] unit-test
 [ t ] [ "s" get @right grid-child slider? ] unit-test
 [ f ] [ "s" get @right grid-child find-scroller* ] unit-test
 

basis/ui/gadgets/sliders/sliders.factor

@@ -104,7 +104,7 @@ elevator H{
 
 : layout-thumb-loc ( slider -- )
     dup thumb-loc (layout-thumb)
-    >r [ floor ] map r> set-rect-loc ;
+    >r [ floor ] map r> (>>loc) ;
 
 : layout-thumb-dim ( slider -- )
     dup dup thumb-dim (layout-thumb) >r

basis/ui/gadgets/status-bar/status-bar-docs.factor

@@ -5,4 +5,4 @@ IN: ui.gadgets.status-bar
 HELP: <status-bar>
 { $values { "model" model } { "gadget" "a new " { $link gadget } } }
 { $description "Creates a new " { $link gadget } " displaying the model value, which must be a string or " { $link f } "." }
-{ $notes "If the " { $snippet "model" } " is " { $link world-status } ", this gadget will display  mouse over help for " { $link "ui.gadgets.presentations" } "." } ;
+{ $notes "If the " { $snippet "model" } " is " { $snippet "status" } ", this gadget will display mouse over help for " { $link "ui.gadgets.presentations" } "." } ;