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

basis/alien/arrays/arrays.factor

@@ -10,7 +10,7 @@ M: array c-type ;
 
 M: array heap-size unclip heap-size [ * ] reduce ;
 
-M: array c-type-align first c-type c-type-align ;
+M: array c-type-align first c-type-align ;
 
 M: array c-type-stack-align? drop f ;
 

basis/alien/c-types/c-types.factor

@@ -37,6 +37,7 @@ ERROR: no-c-type name ;
         dup string? [ (c-type) ] when
     ] when ;
 
+! C type protocol
 GENERIC: c-type ( name -- type ) foldable
 
 : resolve-pointer-type ( name -- name )
@@ -62,6 +63,60 @@ M: string c-type ( name -- type )
         ] ?if
     ] if ;
 
+GENERIC: c-type-boxer ( name -- boxer )
+
+M: c-type c-type-boxer boxer>> ;
+
+M: string c-type-boxer c-type c-type-boxer ;
+
+GENERIC: c-type-boxer-quot ( name -- quot )
+
+M: c-type c-type-boxer-quot boxer-quot>> ;
+
+M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+
+GENERIC: c-type-unboxer ( name -- boxer )
+
+M: c-type c-type-unboxer unboxer>> ;
+
+M: string c-type-unboxer c-type c-type-unboxer ;
+
+GENERIC: c-type-unboxer-quot ( name -- quot )
+
+M: c-type c-type-unboxer-quot unboxer-quot>> ;
+
+M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+
+GENERIC: c-type-reg-class ( name -- reg-class )
+
+M: c-type c-type-reg-class reg-class>> ;
+
+M: string c-type-reg-class c-type c-type-reg-class ;
+
+GENERIC: c-type-getter ( name -- quot )
+
+M: c-type c-type-getter getter>> ;
+
+M: string c-type-getter c-type c-type-getter ;
+
+GENERIC: c-type-setter ( name -- quot )
+
+M: c-type c-type-setter setter>> ;
+
+M: string c-type-setter c-type c-type-setter ;
+
+GENERIC: c-type-align ( name -- n )
+
+M: c-type c-type-align align>> ;
+
+M: string c-type-align c-type c-type-align ;
+
+GENERIC: c-type-stack-align? ( name -- ? )
+
+M: c-type c-type-stack-align? stack-align?>> ;
+
+M: string c-type-stack-align? c-type c-type-stack-align? ;
+
 : c-type-box ( n type -- )
     dup c-type-reg-class
     swap c-type-boxer [ "No boxer" throw ] unless*
@@ -72,10 +127,6 @@ M: string c-type ( name -- type )
     swap c-type-unboxer [ "No unboxer" throw ] unless*
     %unbox ;
 
-M: string c-type-align c-type c-type-align ;
-
-M: string c-type-stack-align? c-type c-type-stack-align? ;
-
 GENERIC: box-parameter ( n ctype -- )
 
 M: c-type box-parameter c-type-box ;
@@ -107,25 +158,25 @@ GENERIC: heap-size ( type -- size ) foldable
 
 M: string heap-size c-type heap-size ;
 
-M: c-type heap-size c-type-size ;
+M: c-type heap-size size>> ;
 
 GENERIC: stack-size ( type -- size ) foldable
 
 M: string stack-size c-type stack-size ;
 
-M: c-type stack-size c-type-size ;
+M: c-type stack-size size>> ;
 
 GENERIC: byte-length ( seq -- n ) flushable
 
 M: byte-array byte-length length ;
 
 : c-getter ( name -- quot )
-    c-type c-type-getter [
+    c-type-getter [
         [ "Cannot read struct fields with type" throw ]
     ] unless* ;
 
 : c-setter ( name -- quot )
-    c-type c-type-setter [
+    c-type-setter [
         [ "Cannot write struct fields with type" throw ]
     ] unless* ;
 

basis/alien/structs/structs-docs.factor

@@ -1,5 +1,5 @@
 IN: alien.structs
-USING: alien.c-types strings help.markup help.syntax
+USING: accessors alien.c-types strings help.markup help.syntax
 alien.syntax sequences io arrays slots.deprecated
 kernel words slots assocs namespaces accessors ;
 
@@ -67,7 +67,7 @@ M: word slot-specs "slots" word-prop ;
     first dup "writing" word-prop [ slot-specs ] keep
     $spec-writer ;
 
-M: string slot-specs c-type struct-type-fields ;
+M: string slot-specs c-type fields>> ;
 
 M: array ($instance) first ($instance) " array" write ;
 

basis/alien/structs/structs-tests.factor

@@ -7,7 +7,7 @@ C-STRUCT: bar
     { { "int" 8 } "y" } ;
 
 [ 36 ] [ "bar" heap-size ] unit-test
-[ t ] [ \ <displaced-alien> "bar" c-type c-type-getter memq? ] unit-test
+[ t ] [ \ <displaced-alien> "bar" c-type-getter memq? ] unit-test
 
 C-STRUCT: align-test
     { "int" "x" }

basis/alien/structs/structs.factor

@@ -6,7 +6,7 @@ slots.deprecated alien.c-types cpu.architecture ;
 IN: alien.structs
 
 : align-offset ( offset type -- offset )
-    c-type c-type-align align ;
+    c-type-align align ;
 
 : struct-offsets ( specs -- size )
     0 [
@@ -24,7 +24,7 @@ IN: alien.structs
     [ reader>> ]
     [
         class>>
-        [ c-getter ] [ c-type c-type-boxer-quot ] bi append
+        [ c-getter ] [ c-type-boxer-quot ] bi append
     ] tri
     define-struct-slot-word ;
 
@@ -44,9 +44,9 @@ IN: alien.structs
 
 TUPLE: struct-type size align fields ;
 
-M: struct-type heap-size struct-type-size ;
+M: struct-type heap-size size>> ;
 
-M: struct-type c-type-align struct-type-align ;
+M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
 

basis/bootstrap/stage2.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors init command-line namespaces words debugger io
+USING: accessors init namespaces words io
 kernel.private math memory continuations kernel io.files
 io.backend system parser vocabs sequences prettyprint
 vocabs.loader combinators splitting source-files strings
 definitions assocs compiler.errors compiler.units
-math.parser generic sets ;
+math.parser generic sets debugger command-line ;
 IN: bootstrap.stage2
 
 SYMBOL: bootstrap-time

basis/calendar/calendar-docs.factor

@@ -1,14 +1,14 @@
 ! Copyright (C) 2008 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel math strings help.markup help.syntax
-calendar.backend ;
+calendar.backend 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." } ;
+{ $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." } ;
 
 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 } "." } ;
+{ $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." } ;
 
 { timestamp duration } related-words
 
@@ -28,4 +28,168 @@ HELP: <date>
 
 HELP: month-names
 { $values { "array" array } }
-{ $description "Returns an array with the English names of all the months. January has a index of 1 instead of 0." } ;
+{ $description "Returns an array with the English names of all the months." }
+{ $warning "Do not use this array for looking up a month name directly. Use month-name instead." } ;
+
+HELP: month-name
+{ $values { "n" integer } { "string" string } }
+{ $description "Looks up the month name and returns it as a string.  January has an index of 1 instead of zero." } ;
+
+HELP: month-abbreviations
+{ $values { "array" array } }
+{ $description "Returns an array with the English abbreviated names of all the months." }
+{ $warning "Do not use this array for looking up a month name directly. Use month-abbreviation instead." } ;
+
+HELP: month-abbreviation
+{ $values { "n" integer } { "string" string } }
+{ $description "Looks up the abbreviated month name and returns it as a string.  January has an index of 1 instead of zero." } ;
+
+
+HELP: day-names
+{ $values { "array" array } }
+{ $description "Returns an array with the English names of the days of the week." } ;
+
+HELP: day-name
+{ $values { "n" integer } { "string" string } }
+{ $description "Looks up the day name and returns it as a string." } ;
+
+HELP: day-abbreviations2
+{ $values { "array" array } }
+{ $description "Returns an array with the abbreviated English names of the days of the week.  This abbreviation is two characters long." } ;
+
+HELP: day-abbreviation2
+{ $values { "n" integer } { "string" string } }
+{ $description "Looks up the abbreviated day name and returns it as a string. This abbreviation is two characters long." } ;
+
+HELP: day-abbreviations3
+{ $values { "array" array } }
+{ $description "Returns an array with the abbreviated English names of the days of the week.  This abbreviation is three characters long." } ;
+
+HELP: day-abbreviation3
+{ $values { "n" integer } { "string" string } }
+{ $description "Looks up the abbreviated day name and returns it as a string. This abbreviation is three characters long." } ;
+
+{
+    day-name day-names
+    day-abbreviation2 day-abbreviations2
+    day-abbreviation3 day-abbreviations3
+} related-words
+
+HELP: average-month
+{ $values { "ratio" ratio } }
+{ $description "The length of an average month averaged over 400 years. Used internally for adding an arbitrary real number of months to a timestamp." } ;
+
+HELP: months-per-year
+{ $values { "integer" integer } }
+{ $description "Returns the number of months in a year." } ;
+
+HELP: days-per-year
+{ $values { "ratio" ratio } }
+{ $description "Returns the number of days in a year averaged over 400 years. Used internally for adding an arbitrary real number of days to a timestamp." } ;
+
+HELP: hours-per-year
+{ $values { "ratio" ratio } }
+{ $description "Returns the number of hours in a year averaged over 400 years. Used internally for adding an arbitrary real number of hours to a timestamp." } ;
+
+HELP: minutes-per-year
+{ $values { "ratio" ratio } }
+{ $description "Returns the number of minutes in a year averaged over 400 years. Used internally for adding an arbitrary real number of minutes to a timestamp." } ;
+
+HELP: seconds-per-year
+{ $values { "integer" integer } }
+{ $description "Returns the number of seconds in a year averaged over 400 years. Used internally for adding an arbitrary real number of seconds to a timestamp." } ;
+
+HELP: julian-day-number
+{ $values { "year" integer } { "month" integer } { "day" integer } { "n" integer } }
+{ $description "Calculates the Julian day number from a year, month, and day.  The difference between two Julian day numbers is the number of days that have elapsed between the two corresponding dates." }
+{ $warning "Not valid before year -4800 BCE." } ;
+
+HELP: julian-day-number>date
+{ $values { "n" integer } { "year" integer } { "month" integer } { "day" integer } }
+{ $description "Converts from a Julian day number back to a year, month, and day." } ;
+{ julian-day-number julian-day-number>date } related-words
+
+HELP: >date<
+{ $values { "timestamp" timestamp } { "year" integer } { "month" integer } { "day" integer } }
+{ $description "Explodes a " { $snippet "timestamp" } " into its year, month, and day components." }
+{ $examples { $example "USING: arrays calendar prettyprint ;"
+                       "2010 8 24 <date> >date< 3array ."
+                       "{ 2010 8 24 }"
+                       }
+} ;
+
+HELP: >time<
+{ $values { "timestamp" timestamp } { "hour" integer } { "minute" integer } { "second" integer } }
+{ $description "Explodes a " { $snippet "timestamp" } " into its hour, minute, and second components." }
+{ $examples { $example "USING: arrays calendar prettyprint ;"
+                       "now noon >time< 3array ."
+                       "{ 12 0 0 }"
+                       }
+} ;
+
+{ >date< >time< } related-words
+
+HELP: instant
+{ $values { "duration" duration } }
+{ $description "Pushes a " { $snippet "duration" } " of zero seconds." } ;
+
+HELP: years
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: months
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: days
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: weeks
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: hours
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: minutes
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: seconds
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: milliseconds
+{ $values { "x" number } { "duration" duration } }
+{ $description } ;
+
+HELP: leap-year?
+{ $values { "obj" object } { "?" "a boolean" } }
+{ $description "Returns " { $link t } " if the object represents a leap year." }
+{ $examples
+    { $example "USING: calendar prettyprint ;"
+               "2008 leap-year? ."
+               "t"
+    }
+    { $example "USING: calendar prettyprint ;"
+               "2010 1 1 <date> leap-year? ."
+               "f"
+    }
+} ;
+
+HELP: time+
+{ $values { "time1" "timestamp or duration" } { "time2" "timestamp or duration" } { "time3" "timestamp or duration" } }
+{ $description "Adds two durations to produce a duration or adds a timestamp and a duration to produce a timestamp. The calculation takes timezones into account." }
+{ $examples
+    { $example "USING: calendar math.order prettyprint ;"
+               "10 months 2 months time+ 1 year <=> ."
+               "+eq+"
+    }
+    { $example "USING: accessors calendar math.order prettyprint ;"
+               "2010 1 1 <date> 3 days time+ day>> ."
+               "4"
+    }
+} ;
+

basis/calendar/calendar.factor

@@ -57,7 +57,7 @@ PRIVATE>
         "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"
     } ;
 
-: month-abbreviation ( n -- array )
+: month-abbreviation ( n -- string )
     check-month 1- month-abbreviations nth ;
 
 : day-names ( -- array )
@@ -116,15 +116,15 @@ PRIVATE>
 : >time< ( timestamp -- hour minute second )
     [ hour>> ] [ minute>> ] [ second>> ] tri ;
 
-MEMO: instant ( -- dt ) 0 0 0 0 0 0 <duration> ;
+MEMO: instant ( -- duration ) 0 0 0 0 0 0 <duration> ;
-: years ( n -- dt ) instant clone swap >>year ;
+: years ( x -- duration ) instant clone swap >>year ;
-: months ( n -- dt ) instant clone swap >>month ;
+: months ( x -- duration ) instant clone swap >>month ;
-: days ( n -- dt ) instant clone swap >>day ;
+: days ( x -- duration ) instant clone swap >>day ;
-: weeks ( n -- dt ) 7 * days ;
+: weeks ( x -- duration ) 7 * days ;
-: hours ( n -- dt ) instant clone swap >>hour ;
+: hours ( x -- duration ) instant clone swap >>hour ;
-: minutes ( n -- dt ) instant clone swap >>minute ;
+: minutes ( x -- duration ) instant clone swap >>minute ;
-: seconds ( n -- dt ) instant clone swap >>second ;
+: seconds ( x -- duration ) instant clone swap >>second ;
-: milliseconds ( n -- dt ) 1000 / seconds ;
+: milliseconds ( x -- duration ) 1000 / seconds ;
 
 GENERIC: leap-year? ( obj -- ? )
 
@@ -218,7 +218,7 @@ M: number +second ( timestamp n -- timestamp )
 
 PRIVATE>
 
-GENERIC# time+ 1 ( time dt -- time )
+GENERIC# time+ 1 ( time1 time2 -- time3 )
 
 M: timestamp time+
     >r clone r> (time+) drop ;
@@ -236,8 +236,8 @@ M: duration time+
         2drop <duration>
     ] if ;
 
-: dt>years ( dt -- x )
+: dt>years ( duration -- x )
-    #! Uses average month/year length since dt loses calendar
+    #! Uses average month/year length since duration loses calendar
     #! data
     0 swap
     {
@@ -251,12 +251,12 @@ M: duration time+
 
 M: duration <=> [ dt>years ] compare ;
 
-: dt>months ( dt -- x ) dt>years months-per-year * ;
+: dt>months ( duration -- x ) dt>years months-per-year * ;
-: dt>days ( dt -- x ) dt>years days-per-year * ;
+: dt>days ( duration -- x ) dt>years days-per-year * ;
-: dt>hours ( dt -- x ) dt>years hours-per-year * ;
+: dt>hours ( duration -- x ) dt>years hours-per-year * ;
-: dt>minutes ( dt -- x ) dt>years minutes-per-year * ;
+: dt>minutes ( duration -- x ) dt>years minutes-per-year * ;
-: dt>seconds ( dt -- x ) dt>years seconds-per-year * ;
+: dt>seconds ( duration -- x ) dt>years seconds-per-year * ;
-: dt>milliseconds ( dt -- x ) dt>seconds 1000 * ;
+: dt>milliseconds ( duration -- x ) dt>seconds 1000 * ;
 
 GENERIC: time- ( time1 time2 -- time )
 
@@ -296,7 +296,7 @@ M: timestamp time-
         } 2cleave <duration>
     ] if ;
 
-: before ( dt -- -dt )
+: before ( duration -- -duration )
     -1 time* ;
 
 M: duration time-
@@ -324,8 +324,8 @@ MEMO: unix-1970 ( -- timestamp )
 
 : now ( -- timestamp ) gmt >local-time ;
 
-: hence ( dt -- timestamp ) now swap time+ ;
+: hence ( duration -- timestamp ) now swap time+ ;
-: ago ( dt -- timestamp ) now swap time- ;
+: ago ( duration -- timestamp ) now swap time- ;
 
 : day-counts { 0 31 28 31 30 31 30 31 31 30 31 30 31 } ; inline
 
@@ -377,23 +377,24 @@ M: timestamp days-in-year ( timestamp -- n ) year>> days-in-year ;
 : friday ( timestamp -- timestamp ) 5 day-this-week ;
 : saturday ( timestamp -- timestamp ) 6 day-this-week ;
 
-: beginning-of-day ( timestamp -- new-timestamp )
+: midnight ( timestamp -- new-timestamp )
-    clone
+    clone 0 >>hour 0 >>minute 0 >>second ; inline
-    0 >>hour
+
-    0 >>minute
+: noon ( timestamp -- new-timestamp )
-    0 >>second ; inline
+    midnight 12 >>hour ; inline
 
 : beginning-of-month ( timestamp -- new-timestamp )
-    beginning-of-day 1 >>day ;
+    midnight 1 >>day ;
 
 : beginning-of-week ( timestamp -- new-timestamp )
-    beginning-of-day sunday ;
+    midnight sunday ;
 
 : beginning-of-year ( timestamp -- new-timestamp )
     beginning-of-month 1 >>month ;
 
 : time-since-midnight ( timestamp -- duration )
-    dup beginning-of-day time- ;
+    dup midnight time- ;
+
 
 M: timestamp sleep-until timestamp>millis sleep-until ;
 

basis/cocoa/views/views.factor

@@ -21,6 +21,10 @@ IN: cocoa.views
 : NSOpenGLPFASampleBuffers 55 ;
 : NSOpenGLPFASamples 56 ;
 : NSOpenGLPFAAuxDepthStencil 57 ;
+: NSOpenGLPFAColorFloat  58 ;
+: NSOpenGLPFAMultisample 59 ;
+: NSOpenGLPFASupersample 60 ;
+: NSOpenGLPFASampleAlpha 61 ;
 : NSOpenGLPFARendererID 70 ;
 : NSOpenGLPFASingleRenderer 71 ;
 : NSOpenGLPFANoRecovery 72 ;
@@ -34,25 +38,36 @@ IN: cocoa.views
 : NSOpenGLPFACompliant 83 ;
 : NSOpenGLPFAScreenMask 84 ;
 : NSOpenGLPFAPixelBuffer 90 ;
+: NSOpenGLPFAAllowOfflineRenderers 96 ;
 : NSOpenGLPFAVirtualScreenCount 128 ;
 
+: kCGLRendererGenericFloatID HEX: 00020400 ;
+
 <PRIVATE
 
 SYMBOL: +software-renderer+
+SYMBOL: +multisample+
 
 PRIVATE>
 
 : with-software-renderer ( quot -- )
-    t +software-renderer+ set
+    t +software-renderer+ pick with-variable ; inline
-    [ f +software-renderer+ set ]
+: with-multisample ( quot -- )
-    [ ] cleanup ; inline
+    t +multisample+ pick with-variable ; inline
 
 : <PixelFormat> ( -- pixelfmt )
     NSOpenGLPixelFormat -> alloc [
         NSOpenGLPFAWindow ,
         NSOpenGLPFADoubleBuffer ,
         NSOpenGLPFADepthSize , 16 ,
-        +software-renderer+ get [ NSOpenGLPFARobust , ] when
+        +software-renderer+ get [
+            NSOpenGLPFARendererID , kCGLRendererGenericFloatID ,
+        ] when
+        +multisample+ get [
+            NSOpenGLPFASupersample ,
+            NSOpenGLPFASampleBuffers , 1 ,
+            NSOpenGLPFASamples , 8 ,
+        ] when
         0 ,
     ] { } make >c-int-array
     -> initWithAttributes:

basis/compiler/generator/registers/registers.factor

@@ -69,23 +69,21 @@ TUPLE: ds-loc n class ;
 
 : <ds-loc> ( n -- loc ) f ds-loc boa ;
 
-M: ds-loc minimal-ds-loc* ds-loc-n min ;
+M: ds-loc minimal-ds-loc* n>> min ;
-M: ds-loc operand-class* ds-loc-class ;
-M: ds-loc set-operand-class set-ds-loc-class ;
 M: ds-loc live-loc?
-    over ds-loc? [ [ ds-loc-n ] bi@ = not ] [ 2drop t ] if ;
+    over ds-loc? [ [ n>> ] bi@ = not ] [ 2drop t ] if ;
 
 ! A retain stack location.
 TUPLE: rs-loc n class ;
 
 : <rs-loc> ( n -- loc ) f rs-loc boa ;
-M: rs-loc operand-class* rs-loc-class ;
-M: rs-loc set-operand-class set-rs-loc-class ;
 M: rs-loc live-loc?
-    over rs-loc? [ [ rs-loc-n ] bi@ = not ] [ 2drop t ] if ;
+    over rs-loc? [ [ n>> ] bi@ = not ] [ 2drop t ] if ;
 
 UNION: loc ds-loc rs-loc ;
 
+M: loc operand-class* class>> ;
+M: loc set-operand-class (>>class) ;
 M: loc move-spec drop loc ;
 
 INSTANCE: loc value
@@ -106,12 +104,12 @@ M: cached set-operand-class vreg>> set-operand-class ;
 M: cached operand-class* vreg>> operand-class* ;
 M: cached move-spec drop cached ;
 M: cached live-vregs* vreg>> live-vregs* ;
-M: cached live-loc? cached-loc live-loc? ;
+M: cached live-loc? loc>> live-loc? ;
 M: cached (lazy-load) >r vreg>> r> (lazy-load) ;
 M: cached lazy-store
-    2dup cached-loc live-loc?
+    2dup loc>> live-loc?
     [ "live-locs" get at %move ] [ 2drop ] if ;
-M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
+M: cached minimal-ds-loc* loc>> minimal-ds-loc* ;
 
 INSTANCE: cached value
 
@@ -121,48 +119,48 @@ TUPLE: tagged vreg class ;
 : <tagged> ( vreg -- tagged )
     f tagged boa ;
 
-M: tagged v>operand tagged-vreg v>operand ;
+M: tagged v>operand vreg>> v>operand ;
-M: tagged set-operand-class set-tagged-class ;
+M: tagged set-operand-class (>>class) ;
-M: tagged operand-class* tagged-class ;
+M: tagged operand-class* class>> ;
 M: tagged move-spec drop f ;
-M: tagged live-vregs* tagged-vreg , ;
+M: tagged live-vregs* vreg>> , ;
 
 INSTANCE: tagged value
 
 ! Unboxed alien pointers
 TUPLE: unboxed-alien vreg ;
 C: <unboxed-alien> unboxed-alien
-M: unboxed-alien v>operand unboxed-alien-vreg v>operand ;
+M: unboxed-alien v>operand vreg>> v>operand ;
 M: unboxed-alien operand-class* drop simple-alien ;
 M: unboxed-alien move-spec class ;
-M: unboxed-alien live-vregs* unboxed-alien-vreg , ;
+M: unboxed-alien live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-alien value
 
 TUPLE: unboxed-byte-array vreg ;
 C: <unboxed-byte-array> unboxed-byte-array
-M: unboxed-byte-array v>operand unboxed-byte-array-vreg v>operand ;
+M: unboxed-byte-array v>operand vreg>> v>operand ;
 M: unboxed-byte-array operand-class* drop c-ptr ;
 M: unboxed-byte-array move-spec class ;
-M: unboxed-byte-array live-vregs* unboxed-byte-array-vreg , ;
+M: unboxed-byte-array live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-byte-array value
 
 TUPLE: unboxed-f vreg ;
 C: <unboxed-f> unboxed-f
-M: unboxed-f v>operand unboxed-f-vreg v>operand ;
+M: unboxed-f v>operand vreg>> v>operand ;
 M: unboxed-f operand-class* drop \ f ;
 M: unboxed-f move-spec class ;
-M: unboxed-f live-vregs* unboxed-f-vreg , ;
+M: unboxed-f live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-f value
 
 TUPLE: unboxed-c-ptr vreg ;
 C: <unboxed-c-ptr> unboxed-c-ptr
-M: unboxed-c-ptr v>operand unboxed-c-ptr-vreg v>operand ;
+M: unboxed-c-ptr v>operand vreg>> v>operand ;
 M: unboxed-c-ptr operand-class* drop c-ptr ;
 M: unboxed-c-ptr move-spec class ;
-M: unboxed-c-ptr live-vregs* unboxed-c-ptr-vreg , ;
+M: unboxed-c-ptr live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-c-ptr value
 

basis/compiler/tests/folding.factor

@@ -0,0 +1,30 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel classes.mixin arrays ;
+IN: compiler.tests
+
+! Calls to generic words were not folded away.
+
+[ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: math arrays ;
+    IN: compiler.tests.folding
+    GENERIC: foldable-generic ( a -- b ) foldable
+    M: integer foldable-generic f <array> ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USING: math arrays ;
+    IN: compiler.tests.folding
+    : fold-test ( -- x ) 10 foldable-generic ;
+    "> eval
+] unit-test
+
+[ t ] [
+    "fold-test" "compiler.tests.folding" lookup execute
+    "fold-test" "compiler.tests.folding" lookup execute
+    eq?
+] unit-test

basis/compiler/tree/escape-analysis/allocations/allocations.factor

@@ -103,6 +103,9 @@ DEFER: copy-value
     [ [ allocation copy-allocation ] dip record-allocation ]
     2bi ;
 
+: copy-values ( from to -- )
+    [ copy-value ] 2each ;
+
 : copy-slot-value ( out slot# in -- )
     allocation {
         { [ dup not ] [ 3drop ] }

basis/compiler/tree/escape-analysis/recursive/recursive.factor

@@ -42,24 +42,26 @@ IN: compiler.tree.escape-analysis.recursive
     ] 2bi ;
 
 M: #recursive escape-analysis* ( #recursive -- )
+    [ label>> return>> in-d>> introduce-values ]
     [
-        child>>
+        [
-        [ first out-d>> introduce-values ]
+            child>>
-        [ first analyze-recursive-phi ]
+            [ first out-d>> introduce-values ]
-        [ (escape-analysis) ]
+            [ first analyze-recursive-phi ]
-        tri
+            [ (escape-analysis) ]
-    ] until-fixed-point ;
+            tri
+        ] until-fixed-point
+    ] bi ;
 
 M: #enter-recursive escape-analysis* ( #enter-recursive -- )
     #! Handled by #recursive
     drop ;
 
-: return-allocations ( node -- allocations )
-    label>> return>> node-input-allocations ;
-
 M: #call-recursive escape-analysis* ( #call-label -- )
-    [ ] [ return-allocations ] [ node-output-allocations ] tri
+    [ ] [ label>> return>> ] [ node-output-allocations ] tri
-    [ check-fixed-point ] [ drop swap out-d>> record-allocations ] 3bi ;
+    [ [ node-input-allocations ] dip check-fixed-point ]
+    [ drop swap [ in-d>> ] [ out-d>> ] bi* copy-values ]
+    3bi ;
 
 M: #return-recursive escape-analysis* ( #return-recursive -- )
     [ call-next-method ]

basis/compiler/tree/escape-analysis/simple/simple.factor

@@ -13,7 +13,7 @@ IN: compiler.tree.escape-analysis.simple
 
 M: #terminate escape-analysis* drop ;
 
-M: #renaming escape-analysis* inputs/outputs [ copy-value ] 2each ;
+M: #renaming escape-analysis* inputs/outputs copy-values ;
 
 M: #introduce escape-analysis* out-d>> unknown-allocations ;
 

basis/compiler/tree/finalization/finalization.factor

@@ -0,0 +1,18 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors sequences
+compiler.tree compiler.tree.combinators ;
+IN: compiler.tree.finalization
+
+GENERIC: finalize* ( node -- nodes )
+
+M: #copy finalize* drop f ;
+
+M: #shuffle finalize*
+    dup shuffle-effect
+    [ in>> ] [ out>> ] bi sequence=
+    [ drop f ] when ;
+
+M: node finalize* ;
+
+: finalize ( nodes -- nodes' ) [ finalize* ] map-nodes ;

basis/compiler/tree/normalization/normalization.factor

@@ -204,5 +204,6 @@ M: node normalize* ;
     H{ } clone rename-map set
     dup [ collect-label-info ] each-node
     dup count-introductions make-values
-    [ (normalize) ] [ nip #introduce ] 2bi prefix
+    [ (normalize) ] [ nip ] 2bi
+    dup empty? [ drop ] [ #introduce prefix ] if
     rename-node-values ;

basis/compiler/tree/optimizer/optimizer.factor

@@ -11,6 +11,7 @@ compiler.tree.strength-reduction
 compiler.tree.loop.detection
 compiler.tree.loop.inversion
 compiler.tree.branch-fusion
+compiler.tree.finalization
 compiler.tree.checker ;
 IN: compiler.tree.optimizer
 
@@ -25,6 +26,7 @@ IN: compiler.tree.optimizer
     unbox-tuples
     compute-def-use
     remove-dead-code
+    finalize
     ! strength-reduce
     ! USE: kernel
     ! compute-def-use

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

@@ -12,8 +12,6 @@ IN: compiler.tree.propagation.info
 
 : null-class? ( class -- ? ) null class<= ;
 
-SYMBOL: +interval+
-
 GENERIC: eql? ( obj1 obj2 -- ? )
 M: object eql? eq? ;
 M: fixnum eql? eq? ;
@@ -40,7 +38,7 @@ slots ;
 
 : class-interval ( class -- interval )
     dup real class<=
-    [ +interval+ word-prop [-inf,inf] or ] [ drop f ] if ;
+    [ "interval" word-prop [-inf,inf] or ] [ drop f ] if ;
 
 : interval>literal ( class interval -- literal literal? )
     #! If interval has zero length and the class is sufficiently
@@ -84,7 +82,7 @@ slots ;
     init-value-info ; foldable
 
 : <class-info> ( class -- info )
-    dup word? [ dup +interval+ word-prop ] [ f ] if [-inf,inf] or
+    dup word? [ dup "interval" word-prop ] [ f ] if [-inf,inf] or
     <class/interval-info> ; foldable
 
 : <interval-info> ( interval -- info )

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel arrays sequences math math.order
-math.partial-dispatch generic generic.standard classes.algebra
+math.partial-dispatch generic generic.standard generic.math
-classes.union sets quotations assocs combinators words
+classes.algebra classes.union sets quotations assocs combinators
-namespaces
+words namespaces
 compiler.tree
 compiler.tree.builder
 compiler.tree.normalization
@@ -145,3 +145,13 @@ SYMBOL: history
 
 : always-inline-word? ( word -- ? )
     { curry compose } memq? ;
+
+: do-inlining ( #call word -- ? )
+    {
+        { [ dup always-inline-word? ] [ inline-word ] }
+        { [ dup standard-generic? ] [ inline-standard-method ] }
+        { [ dup math-generic? ] [ inline-math-method ] }
+        { [ dup math-partial? ] [ inline-math-partial ] }
+        { [ dup method-body? ] [ inline-method-body ] }
+        [ 2drop f ]
+    } cond ;

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

@@ -17,11 +17,11 @@ IN: compiler.tree.propagation.known-words
 
 \ fixnum
 most-negative-fixnum most-positive-fixnum [a,b]
-+interval+ set-word-prop
+"interval" set-word-prop
 
 \ array-capacity
 0 max-array-capacity [a,b]
-+interval+ set-word-prop
+"interval" set-word-prop
 
 { + - * / }
 [ { number number } "input-classes" set-word-prop ] each
@@ -66,17 +66,17 @@ most-negative-fixnum most-positive-fixnum [a,b]
     over interval>> [ [ clone ] dip change-interval ] [ 2drop ] if ; inline
 
 { bitnot fixnum-bitnot bignum-bitnot } [
-    [ [ interval-bitnot ] ?change-interval ] +outputs+ set-word-prop
+    [ [ interval-bitnot ] ?change-interval ] "outputs" set-word-prop
 ] each
 
-\ abs [ [ interval-abs ] ?change-interval ] +outputs+ set-word-prop
+\ abs [ [ interval-abs ] ?change-interval ] "outputs" set-word-prop
 
 : math-closure ( class -- newclass )
     { fixnum bignum integer rational float real number object }
     [ class<= ] with find nip ;
 
 : fits? ( interval class -- ? )
-    +interval+ word-prop interval-subset? ;
+    "interval" word-prop interval-subset? ;
 
 : binary-op-class ( info1 info2 -- newclass )
     [ class>> ] bi@
@@ -120,7 +120,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
         [ binary-op-class ] [ , binary-op-interval ] 2bi
         @
         <class/interval-info>
-    ] +outputs+ set-word-prop ;
+    ] "outputs" set-word-prop ;
 
 \ + [ [ interval+ ] [ may-overflow number-valued ] binary-op ] each-derived-op
 \ + [ [ interval+ ] [ number-valued ] binary-op ] each-fast-derived-op
@@ -158,7 +158,7 @@ most-negative-fixnum most-positive-fixnum [a,b]
     in1 in2 op negate-comparison (comparison-constraints) out f--> /\ ;
 
 : define-comparison-constraints ( word op -- )
-    '[ , comparison-constraints ] +constraints+ set-word-prop ;
+    '[ , comparison-constraints ] "constraints" set-word-prop ;
 
 comparison-ops
 [ dup '[ , define-comparison-constraints ] each-derived-op ] each
@@ -178,13 +178,13 @@ generic-comparison-ops [
 
 comparison-ops [
     dup '[
-        [ , fold-comparison ] +outputs+ set-word-prop
+        [ , fold-comparison ] "outputs" set-word-prop
     ] each-derived-op
 ] each
 
 generic-comparison-ops [
     dup specific-comparison
-    '[ , fold-comparison ] +outputs+ set-word-prop
+    '[ , fold-comparison ] "outputs" set-word-prop
 ] each
 
 : maybe-or-never ( ? -- info )
@@ -196,7 +196,7 @@ generic-comparison-ops [
 { number= bignum= float= } [
     [
         info-intervals-intersect? maybe-or-never
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] each
 
 : info-classes-intersect? ( info1 info2 -- ? )
@@ -206,13 +206,13 @@ generic-comparison-ops [
     over value-info literal>> fixnum? [
         [ value-info literal>> is-equal-to ] dip t-->
     ] [ 3drop f ] if
-] +constraints+ set-word-prop
+] "constraints" set-word-prop
 
 \ eq? [
     [ info-intervals-intersect? ]
     [ info-classes-intersect? ]
     2bi or maybe-or-never
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 {
     { >fixnum fixnum }
@@ -226,7 +226,7 @@ generic-comparison-ops [
             interval-intersect
         ] 2bi
         <class/interval-info>
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] assoc-each
 
 {
@@ -250,36 +250,36 @@ generic-comparison-ops [
         }
     } cond
     [ fixnum fits? fixnum integer ? ] keep <class/interval-info>
-    [ 2nip ] curry +outputs+ set-word-prop
+    [ 2nip ] curry "outputs" set-word-prop
 ] each
 
 { <tuple> <tuple-boa> } [
     [
         literal>> dup tuple-layout? [ class>> ] [ drop tuple ] if <class-info>
         [ clear ] dip
-    ] +outputs+ set-word-prop
+    ] "outputs" set-word-prop
 ] each
 
 \ new [
     literal>> dup tuple-class? [ drop tuple ] unless <class-info>
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 ! the output of clone has the same type as the input
 { clone (clone) } [
     [ clone f >>literal f >>literal? ]
-    +outputs+ set-word-prop
+    "outputs" set-word-prop
 ] each
 
 \ slot [
     dup literal?>>
     [ literal>> swap value-info-slot ] [ 2drop object-info ] if
-] +outputs+ set-word-prop
+] "outputs" set-word-prop
 
 \ instance? [
     [ value-info ] dip over literal>> class? [
         [ literal>> ] dip predicate-constraints
     ] [ 3drop f ] if
-] +constraints+ set-word-prop
+] "constraints" set-word-prop
 
 \ instance? [
     ! We need to force the caller word to recompile when the class
@@ -292,4 +292,4 @@ generic-comparison-ops [
         [ predicate-output-infos ]
         bi
     ] [ 2drop object-info ] if
-] +outputs+ set-word-prop
+] "outputs" set-word-prop

basis/compiler/tree/propagation/nodes/nodes.factor

@@ -6,9 +6,6 @@ compiler.tree.propagation.copy
 compiler.tree.propagation.info ;
 IN: compiler.tree.propagation.nodes
 
-SYMBOL: +constraints+
-SYMBOL: +outputs+
-
 GENERIC: propagate-before ( node -- )
 
 GENERIC: propagate-after ( node -- )

basis/compiler/tree/propagation/simple/simple.factor

@@ -3,8 +3,7 @@
 USING: fry accessors kernel sequences sequences.private assocs words
 namespaces classes.algebra combinators classes classes.tuple
 classes.tuple.private continuations arrays
-math math.partial-dispatch math.private slots generic definitions
+math math.private slots generic definitions
-generic.standard generic.math
 stack-checker.state
 compiler.tree
 compiler.tree.propagation.info
@@ -52,7 +51,7 @@ M: #declare propagate-before
     with-datastack first assume ;
 
 : compute-constraints ( #call word -- )
-    dup +constraints+ word-prop [ nip custom-constraints ] [
+    dup "constraints" word-prop [ nip custom-constraints ] [
         dup predicate? [
             [ [ in-d>> first ] [ out-d>> first ] bi ]
             [ "predicating" word-prop ] bi*
@@ -61,19 +60,22 @@ M: #declare propagate-before
     ] if* ;
 
 : call-outputs-quot ( #call word -- infos )
-    [ in-d>> [ value-info ] map ] [ +outputs+ word-prop ] bi*
+    [ in-d>> [ value-info ] map ] [ "outputs" word-prop ] bi*
     with-datastack ;
 
 : foldable-call? ( #call word -- ? )
     "foldable" word-prop
     [ in-d>> [ value-info literal?>> ] all? ] [ drop f ] if ;
 
-: fold-call ( #call word -- infos )
+: (fold-call) ( #call word -- info )
     [ [ out-d>> ] [ in-d>> [ value-info literal>> ] map ] bi ] [ '[ , execute ] ] bi*
     '[ , , with-datastack [ <literal-info> ] map nip ]
     [ drop [ object-info ] replicate ]
     recover ;
 
+: fold-call ( #call word -- )
+    [ (fold-call) ] [ drop out-d>> ] 2bi set-value-infos ;
+
 : predicate-output-infos ( info class -- info )
     [ class>> ] dip {
         { [ 2dup class<= ] [ t <literal-info> ] }
@@ -95,30 +97,23 @@ M: #declare propagate-before
 
 : output-value-infos ( #call word -- infos )
     {
-        { [ 2dup foldable-call? ] [ fold-call ] }
         { [ dup tuple-constructor? ] [ propagate-tuple-constructor ] }
         { [ dup sequence-constructor? ] [ propagate-sequence-constructor ] }
         { [ dup predicate? ] [ propagate-predicate ] }
-        { [ dup +outputs+ word-prop ] [ call-outputs-quot ] }
+        { [ dup "outputs" word-prop ] [ call-outputs-quot ] }
         [ default-output-value-infos ]
     } cond ;
 
-: do-inlining ( #call word -- ? )
-    {
-        { [ dup always-inline-word? ] [ inline-word ] }
-        { [ dup standard-generic? ] [ inline-standard-method ] }
-        { [ dup math-generic? ] [ inline-math-method ] }
-        { [ dup math-partial? ] [ inline-math-partial ] }
-        { [ dup method-body? ] [ inline-method-body ] }
-        [ 2drop f ]
-    } cond ;
-
 M: #call propagate-before
-    dup word>> 2dup do-inlining [ 2drop ] [
+    dup word>> {
-        [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ]
+        { [ 2dup foldable-call? ] [ fold-call ] }
-        [ compute-constraints ]
+        { [ 2dup do-inlining ] [ 2drop ] }
-        2bi
+        [
-    ] if ;
+            [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ]
+            [ compute-constraints ]
+            2bi
+        ]
+    } cond ;
 
 M: #call annotate-node
     dup [ in-d>> ] [ out-d>> ] bi append (annotate-node) ;

basis/compiler/tree/tuple-unboxing/tuple-unboxing-tests.factor

@@ -46,3 +46,10 @@ TUPLE: empty-tuple ;
     [ bleach-node ] curry [ ] compose impeach-node ; inline recursive
 
 [ ] [ [ [ ] bleach-node ] test-unboxing ] unit-test
+
+TUPLE: box { i read-only } ;
+
+: box-test ( m -- n )
+    dup box-test i>> swap box-test drop box boa ; inline recursive
+
+[ ] [ [ T{ box f 34 } box-test i>> ] test-unboxing ] unit-test

basis/cpu/ppc/allot/allot.factor

@@ -2,7 +2,8 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel cpu.ppc.architecture cpu.ppc.assembler
 kernel.private namespaces math sequences generic arrays
-generator generator.registers generator.fixup system layouts
+compiler.generator compiler.generator.registers
+compiler.generator.fixup system layouts
 cpu.architecture alien ;
 IN: cpu.ppc.allot
 

basis/cpu/ppc/architecture/architecture.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types cpu.ppc.assembler cpu.architecture generic
+USING: accessors alien.c-types cpu.ppc.assembler
-kernel kernel.private math memory namespaces sequences words
+cpu.architecture generic kernel kernel.private math memory
-assocs compiler.generator compiler.generator.registers
+namespaces sequences words assocs compiler.generator
-compiler.generator.fixup system layouts classes words.private
+compiler.generator.registers compiler.generator.fixup system
-alien combinators compiler.constants math.order ;
+layouts classes words.private alien combinators
+compiler.constants math.order ;
 IN: cpu.ppc.architecture
 
 ! PowerPC register assignments
@@ -65,8 +66,8 @@ M: float-regs vregs drop { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
 
 GENERIC: loc>operand ( loc -- reg n )
 
-M: ds-loc loc>operand ds-loc-n cells neg ds-reg swap ;
+M: ds-loc loc>operand n>> cells neg ds-reg swap ;
-M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap ;
+M: rs-loc loc>operand n>> cells neg rs-reg swap ;
 
 M: immediate load-literal
     [ v>operand ] bi@ LOAD ;

basis/cpu/ppc/intrinsics/intrinsics.factor

@@ -5,9 +5,10 @@ cpu.ppc.assembler cpu.ppc.architecture cpu.ppc.allot
 cpu.architecture kernel kernel.private math math.private
 namespaces sequences words generic quotations byte-arrays
 hashtables hashtables.private compiler.generator
-compiler.generator.registers generator.fixup sequences.private
+compiler.generator.registers compiler.generator.fixup
-sbufs vectors system layouts math.floats.private classes
+sequences.private sbufs vectors system layouts
-slots.private combinators compiler.constants ;
+math.floats.private classes slots.private combinators
+compiler.constants ;
 IN: cpu.ppc.intrinsics
 
 : %slot-literal-known-tag
@@ -436,44 +437,44 @@ IN: cpu.ppc.intrinsics
     { +clobber+ { "n" } }
 } define-intrinsic
 
-\ (tuple) [
+! \ (tuple) [
-    tuple "layout" get size>> 2 + cells %allot
+!     tuple "layout" get size>> 2 + cells %allot
-    ! Store layout
+!     ! Store layout
-    "layout" get 12 load-indirect
+!     "layout" get 12 load-indirect
-    12 11 cell STW
+!     12 11 cell STW
-    ! Store tagged ptr in reg
+!     ! Store tagged ptr in reg
-    "tuple" get tuple %store-tagged
+!     "tuple" get tuple %store-tagged
-] H{
+! ] H{
-    { +input+ { { [ ] "layout" } } }
+!     { +input+ { { [ ] "layout" } } }
-    { +scratch+ { { f "tuple" } } }
+!     { +scratch+ { { f "tuple" } } }
-    { +output+ { "tuple" } }
+!     { +output+ { "tuple" } }
-} define-intrinsic
+! } define-intrinsic
-
+! 
-\ (array) [
+! \ (array) [
-    array "n" get 2 + cells %allot
+!     array "n" get 2 + cells %allot
-    ! Store length
+!     ! Store length
-    "n" operand 12 LI
+!     "n" operand 12 LI
-    12 11 cell STW
+!     12 11 cell STW
-    ! Store tagged ptr in reg
+!     ! Store tagged ptr in reg
-    "array" get object %store-tagged
+!     "array" get object %store-tagged
-] H{
+! ] H{
-    { +input+ { { [ ] "n" } } }
+!     { +input+ { { [ ] "n" } } }
-    { +scratch+ { { f "array" } } }
+!     { +scratch+ { { f "array" } } }
-    { +output+ { "array" } }
+!     { +output+ { "array" } }
-} define-intrinsic
+! } define-intrinsic
-
+! 
-\ (byte-array) [
+! \ (byte-array) [
-    byte-array "n" get 2 cells + %allot
+!     byte-array "n" get 2 cells + %allot
-    ! Store length
+!     ! Store length
-    "n" operand 12 LI
+!     "n" operand 12 LI
-    12 11 cell STW
+!     12 11 cell STW
-    ! Store tagged ptr in reg
+!     ! Store tagged ptr in reg
-    "array" get object %store-tagged
+!     "array" get object %store-tagged
-] H{
+! ] H{
-    { +input+ { { [ ] "n" } } }
+!     { +input+ { { [ ] "n" } } }
-    { +scratch+ { { f "array" } } }
+!     { +scratch+ { { f "array" } } }
-    { +output+ { "array" } }
+!     { +output+ { "array" } }
-} define-intrinsic
+! } define-intrinsic
 
 \ <ratio> [
     ratio 3 cells %allot

basis/cpu/ppc/ppc.factor

@@ -1,14 +1,15 @@
-USING: cpu.ppc.architecture cpu.ppc.intrinsics cpu.architecture
+USING: accessors cpu.ppc.architecture cpu.ppc.intrinsics
-namespaces alien.c-types kernel system combinators ;
+cpu.architecture namespaces alien.c-types kernel system
+combinators ;
 
 {
     { [ os macosx? ] [
-        4 "longlong" c-type set-c-type-align
+        4 "longlong" c-type (>>align)
-        4 "ulonglong" c-type set-c-type-align
+        4 "ulonglong" c-type (>>align)
-        4 "double" c-type set-c-type-align
+        4 "double" c-type (>>align)
     ] }
     { [ os linux? ] [
-        t "longlong" c-type set-c-type-stack-align?
+        t "longlong" c-type (>>stack-align?)
-        t "ulonglong" c-type set-c-type-stack-align?
+        t "ulonglong" c-type (>>stack-align?)
     ] }
 } cond

basis/cpu/x86/32/32.factor

@@ -259,9 +259,9 @@ M: x86.32 %cleanup ( alien-node -- )
 M: x86.32 %unwind ( n -- ) %epilogue-later RET ;
 
 os windows? [
-    cell "longlong" c-type set-c-type-align
+    cell "longlong" c-type (>>align)
-    cell "ulonglong" c-type set-c-type-align
+    cell "ulonglong" c-type (>>align)
-    4 "double" c-type set-c-type-align
+    4 "double" c-type (>>align)
 ] unless
 
 : (sse2?) ( -- ? ) "Intrinsic" throw ;

basis/cpu/x86/64/64.factor

@@ -174,10 +174,10 @@ USE: cpu.x86.intrinsics
 
 ! The ABI for passing structs by value is pretty messed up
 << "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type set-c-type-reg-class >>
+stack-params "__stack_value" c-type (>>reg-class) >>
 
 : struct-types&offset ( struct-type -- pairs )
-    struct-type-fields [
+    fields>> [
         [ class>> ] [ offset>> ] bi 2array
     ] map ;
 

basis/cpu/x86/architecture/architecture.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays cpu.x86.assembler
+USING: accessors alien alien.c-types arrays cpu.x86.assembler
 cpu.x86.assembler.private cpu.architecture kernel kernel.private
 math memory namespaces sequences words compiler.generator
 compiler.generator.registers compiler.generator.fixup system
@@ -16,8 +16,8 @@ HOOK: stack-save-reg cpu ( -- reg )
 
 : reg-stack ( n reg -- op ) swap cells neg [+] ;
 
-M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
+M: ds-loc v>operand n>> ds-reg reg-stack ;
-M: rs-loc v>operand rs-loc-n rs-reg reg-stack ;
+M: rs-loc v>operand n>> rs-reg reg-stack ;
 
 M: int-regs %save-param-reg drop >r stack@ r> MOV ;
 M: int-regs %load-param-reg drop swap stack@ MOV ;

basis/debugger/debugger.factor

@@ -207,7 +207,7 @@ M: no-case summary
 
 M: slice-error error.
     "Cannot create slice because " write
-    slice-error-reason print ;
+    reason>> print ;
 
 M: bounds-error summary drop "Sequence index out of bounds" ;
 
@@ -232,14 +232,14 @@ M: immutable summary drop "Sequence is immutable" ;
 
 M: redefine-error error.
     "Re-definition of " write
-    redefine-error-def . ;
+    def>> . ;
 
 M: undefined summary
     drop "Calling a deferred word before it has been defined" ;
 
 M: no-compilation-unit error.
     "Attempting to define " write
-    no-compilation-unit-definition pprint
+    definition>> pprint
     " outside of a compilation unit" print ;
 
 M: no-vocab summary
@@ -299,9 +299,9 @@ M: string expected>string ;
 
 M: unexpected error.
     "Expected " write
-    dup unexpected-want expected>string write
+    dup want>> expected>string write
     " but got " write
-    unexpected-got expected>string print ;
+    got>> expected>string print ;
 
 M: lexer-error error.
     [ lexer-dump ] [ error>> error. ] bi ;

basis/documents/documents.factor

@@ -28,10 +28,10 @@ TUPLE: document < model locs ;
 : update-locs ( loc document -- )
     locs>> [ set-model ] with each ;
 
-: doc-line ( n document -- string ) model-value nth ;
+: doc-line ( n document -- string ) value>> nth ;
 
 : doc-lines ( from to document -- slice )
-    >r 1+ r> model-value <slice> ;
+    >r 1+ r> value>> <slice> ;
 
 : start-on-line ( document from line# -- n1 )
     >r dup first r> = [ nip second ] [ 2drop 0 ] if ;
@@ -99,7 +99,7 @@ TUPLE: document < model locs ;
     >r >r >r "" r> r> r> set-doc-range ;
 
 : last-line# ( document -- line )
-    model-value length 1- ;
+    value>> length 1- ;
 
 : validate-line ( line document -- line )
     last-line# min 0 max ;
@@ -117,7 +117,7 @@ TUPLE: document < model locs ;
     [ last-line# ] keep line-end ;
 
 : validate-loc ( loc document -- newloc )
-    over first over model-value length >= [
+    over first over value>> length >= [
         nip doc-end
     ] [
         over first 0 < [
@@ -128,7 +128,7 @@ TUPLE: document < model locs ;
     ] if ;
 
 : doc-string ( document -- str )
-    model-value "\n" join ;
+    value>> "\n" join ;
 
 : set-doc-string ( string document -- )
     >r string-lines V{ } like r> [ set-model ] keep

basis/help/definitions/definitions.factor

@@ -1,6 +1,6 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: definitions help help.topics help.syntax
+USING: accessors definitions help help.topics help.syntax
 prettyprint.backend prettyprint words kernel effects ;
 IN: help.definitions
 
@@ -8,30 +8,30 @@ IN: help.definitions
 
 M: link definer drop \ ARTICLE: \ ; ;
 
-M: link where link-name article article-loc ;
+M: link where name>> article loc>> ;
 
-M: link set-where link-name article set-article-loc ;
+M: link set-where name>> article (>>loc) ;
 
-M: link forget* link-name remove-article ;
+M: link forget* name>> remove-article ;
 
 M: link definition article-content ;
 
 M: link synopsis*
     dup definer.
-    dup link-name pprint*
+    dup name>> pprint*
     article-title pprint* ;
 
 M: word-link definer drop \ HELP: \ ; ;
 
-M: word-link where link-name "help-loc" word-prop ;
+M: word-link where name>> "help-loc" word-prop ;
 
-M: word-link set-where link-name swap "help-loc" set-word-prop ;
+M: word-link set-where name>> swap "help-loc" set-word-prop ;
 
-M: word-link definition link-name "help" word-prop ;
+M: word-link definition name>> "help" word-prop ;
 
 M: word-link synopsis*
     dup definer.
-    link-name dup pprint-word
+    name>> dup pprint-word
     stack-effect. ;
 
-M: word-link forget* link-name remove-word-help ;
+M: word-link forget* name>> remove-word-help ;

basis/help/lint/lint.factor

@@ -131,7 +131,7 @@ M: help-error error.
 : run-help-lint ( prefix -- alist )
     [
         all-vocabs-seq [ vocab-name ] map "all-vocabs" set
-        articles get keys "group-articles" set
+        group-articles "vocab-articles" set
         child-vocabs
         [ dup check-vocab ] { } map>assoc
         [ nip empty? not ] assoc-filter

basis/help/markup/markup.factor

@@ -143,13 +143,13 @@ M: f print-element drop ;
     link-style get [ write-object ] with-style ;
 
 : ($link) ( article -- )
-    [ dup article-name swap >link write-link ] ($span) ;
+    [ [ article-name ] [ >link ] bi write-link ] ($span) ;
 
 : $link ( element -- )
     first ($link) ;
 
 : ($long-link) ( object -- )
-    dup article-title swap >link write-link ;
+    [ article-title ] [ >link ] bi write-link ;
 
 : ($subsection) ( element quot -- )
     [

basis/help/syntax/syntax.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel parser sequences words help help.topics
+USING: accessors arrays kernel parser sequences words help
-namespaces vocabs definitions compiler.units ;
+help.topics namespaces vocabs definitions compiler.units ;
 IN: help.syntax
 
 : HELP:
@@ -16,7 +16,6 @@ IN: help.syntax
     over add-article >link r> remember-definition ; parsing
 
 : ABOUT:
-    scan-object
     in get vocab
     dup changed-definition
-    set-vocab-help ; parsing
+    scan-object >>help drop ; parsing

basis/help/topics/topics-tests.factor

@@ -1,6 +1,6 @@
-USING: definitions help help.topics help.crossref help.markup
+USING: accessors definitions help help.topics help.crossref
-help.syntax kernel sequences tools.test words parser namespaces
+help.markup help.syntax kernel sequences tools.test words parser
-assocs source-files eval ;
+namespaces assocs source-files eval ;
 IN: help.topics.tests
 
 \ article-name must-infer
@@ -34,6 +34,6 @@ SYMBOL: foo
 ] unit-test
 
 [ { "testfile" 2 } ]
-[ { "test" 1 } articles get at article-loc ] unit-test
+[ { "test" 1 } articles get at loc>> ] unit-test
 
 [ ] [ { "test" 1 } remove-article ] unit-test

basis/help/topics/topics.factor

@@ -34,6 +34,8 @@ SYMBOL: article-xref
 article-xref global [ H{ } assoc-like ] change-at
 
 GENERIC: article-name ( topic -- string )
+GENERIC: article-title ( topic -- string )
+GENERIC: article-content ( topic -- content )
 GENERIC: article-parent ( topic -- parent )
 GENERIC: set-article-parent ( parent topic -- )
 
@@ -42,7 +44,9 @@ TUPLE: article title content loc ;
 : <article> ( title content -- article )
     f \ article boa ;
 
-M: article article-name article-title ;
+M: article article-name title>> ;
+M: article article-title title>> ;
+M: article article-content content>> ;
 
 ERROR: no-article name ;
 

basis/io/mmap/mmap-docs.factor

@@ -5,8 +5,8 @@ IN: io.mmap
 HELP: mapped-file
 { $class-description "The class of memory-mapped files, opened by " { $link <mapped-file> } " and closed by " { $link close-mapped-file } ". The following two slots are of interest to users:"
     { $list
-        { { $link mapped-file-length } " - the length of the mapped file area, in bytes" }
+        { { $snippet "length" } " - the length of the mapped file area, in bytes" }
-        { { $link mapped-file-address } " - an " { $link alien } " pointing at the file's memory area" }
+        { { $snippet "address" } " - an " { $link alien } " pointing at the file's memory area" }
     }
 } ;
 
@@ -33,8 +33,7 @@ ARTICLE: "io.mmap" "Memory-mapped files"
 $nl
 "A utility combinator which wraps the above:"
 { $subsection with-mapped-file }
-"Memory mapped files implement the " { $link "sequence-protocol" } " and present themselves as a sequence of bytes. The underlying memory area can also be accessed directly:"
+"Memory mapped files implement the " { $link "sequence-protocol" } " and present themselves as a sequence of bytes. The underlying memory area can also be accessed directly with the " { $snippet "address" } " slot." $nl
-{ $subsection mapped-file-address }
 "Data can be read and written from the memory area using alien words. See " { $link "reading-writing-memory" } "." ;
 
 ABOUT: "io.mmap"

basis/io/ports/ports.factor

@@ -109,7 +109,7 @@ M: output-port stream-write1
 
 M: output-port stream-write
     dup check-disposed
-    over length over buffer>> buffer-size > [
+    over length over buffer>> size>> > [
         [ buffer>> size>> <groups> ]
         [ [ stream-write ] curry ] bi
         each

basis/macros/expander/expander.factor

@@ -32,8 +32,8 @@ M: wrapper expand-macros* wrapped>> literal ;
     stack get pop >quotation end (expand-macros) ;
 
 : expand-macro? ( word -- quot ? )
-    dup [ "macro" word-prop ] [ +transform-quot+ word-prop ] bi or dup [
+    dup [ "macro" word-prop ] [ "transform-quot" word-prop ] bi or dup [
-        swap [ stack-effect in>> length ] [ +transform-n+ word-prop ] bi or
+        swap [ stack-effect in>> length ] [ "transform-n" word-prop ] bi or
         stack get length <=
     ] [ 2drop f f ] if ;
 

basis/models/compose/compose-docs.factor

@@ -20,7 +20,7 @@ $nl
 
 HELP: <compose>
 { $values { "models" "a sequence of models" } { "compose" "a new " { $link compose } } }
-{ $description "Creates a new instance of " { $link compose } ". The value of the new compose model is obtained by mapping " { $link model-value } " over the given sequence of models." }
+{ $description "Creates a new instance of " { $link compose } ". The value of the new compose model is obtained by mapping the " { $snippet "value" } " slot accessor over the given sequence of models." }
 { $examples "See the example in the documentation for " { $link compose } "." } ;
 
 ARTICLE: "models-compose" "Composed models"

basis/models/delay/delay.factor

@@ -6,7 +6,7 @@ IN: models.delay
 TUPLE: delay < model model timeout alarm ;
 
 : update-delay-model ( delay -- )
-    [ delay-model model-value ] keep set-model ;
+    [ model>> value>> ] keep set-model ;
 
 : <delay> ( model timeout -- delay )
     f delay new-model
@@ -15,7 +15,7 @@ TUPLE: delay < model model timeout alarm ;
         [ add-dependency ] keep ;
 
 : cancel-delay ( delay -- )
-    delay-alarm [ cancel-alarm ] when* ;
+    alarm>> [ cancel-alarm ] when* ;
 
 : start-delay ( delay -- )
     dup

basis/models/history/history.factor

@@ -14,7 +14,7 @@ TUPLE: history < model back forward ;
         reset-history ;
 
 : (add-history) ( history to -- )
-    swap model-value dup [ swap push ] [ 2drop ] if ;
+    swap value>> dup [ swap push ] [ 2drop ] if ;
 
 : go-back/forward ( history to from -- )
     dup empty?
@@ -22,11 +22,11 @@ TUPLE: history < model back forward ;
     [ >r dupd (add-history) r> pop swap set-model ] if ;
 
 : go-back ( history -- )
-    dup history-forward over history-back go-back/forward ;
+    dup [ forward>> ] [ back>> ] bi go-back/forward ;
 
 : go-forward ( history -- )
-    dup history-back over history-forward go-back/forward ;
+    dup [ back>> ] [ forward>> ] bi go-back/forward ;
 
 : add-history ( history -- )
-    dup history-forward delete-all
+    dup forward>> delete-all
-    dup history-back (add-history) ;
+    dup back>> (add-history) ;

basis/models/models-docs.factor

@@ -63,12 +63,7 @@ HELP: set-model
 { $values { "value" object } { "model" model } }
 { $description "Changes the value of a model and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;
 
-{ set-model set-model-value change-model (change-model) } related-words
+{ set-model change-model (change-model) } related-words
-
-HELP: set-model-value ( value model -- )
-{ $values { "value" object } { "model" model } }
-{ $description "Changes the value of a model without notifying any observers registered with " { $link add-connection } "." }
-{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link set-model } ", which notifies observers." } ;
 
 HELP: change-model
 { $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } }

basis/multiline/multiline.factor

@@ -5,7 +5,7 @@ accessors ;
 IN: multiline
 
 : next-line-text ( -- str )
-    lexer get dup next-line text>> ;
+    lexer get dup next-line line-text>> ;
 
 : (parse-here) ( -- )
     next-line-text [
@@ -23,7 +23,7 @@ IN: multiline
     parse-here 1quotation define-inline ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
-    lexer get text>> [
+    lexer get line-text>> [
         2dup start
         [ rot dupd >r >r swap subseq % r> r> length + ] [
             rot tail % "\n" % 0

basis/peg/parsers/parsers.factor

@@ -17,7 +17,7 @@ TUPLE: just-parser p1 ;
 
 
 M: just-parser (compile) ( parser -- quot )
-  just-parser-p1 compile-parser just-pattern curry ;
+  p1>> compile-parser just-pattern curry ;
 
 : just ( parser -- parser )
   just-parser boa wrap-peg ;

basis/prettyprint/backend/backend.factor

@@ -105,7 +105,7 @@ M: sbuf pprint*
     dup "SBUF\" " "\"" pprint-string ;
 
 M: pathname pprint*
-    dup pathname-string "P\" " "\"" pprint-string ;
+    dup string>> "P\" " "\"" pprint-string ;
 
 ! Sequences
 : nesting-limit? ( -- ? )

basis/prettyprint/prettyprint.factor

@@ -172,7 +172,7 @@ M: hook-generic synopsis*
         [ definer. ]
         [ seeing-word ]
         [ pprint-word ]
-        [ "combination" word-prop hook-combination-var pprint* ]
+        [ "combination" word-prop var>> pprint* ]
         [ stack-effect. ]
     } cleave ;
 

basis/prettyprint/sections/sections.factor

@@ -205,7 +205,7 @@ TUPLE: text < section string ;
         swap >>style
         swap >>string ;
 
-M: text short-section text-string write ;
+M: text short-section string>> write ;
 
 M: text long-section short-section ;
 
@@ -291,17 +291,13 @@ SYMBOL: next
 
 : split-groups ( ? -- ) [ t , ] when ;
 
-M: f section-start-group? drop t ;
-
-M: f section-end-group? drop f ;
-
 : split-before ( section -- )
-    [ section-start-group? prev get section-end-group? and ]
+    [ start-group?>> prev get [ end-group?>> ] [ t ] if* and ]
     [ flow? prev get flow? not and ]
     bi or split-groups ;
 
 : split-after ( section -- )
-    section-end-group? split-groups ;
+    [ end-group?>> ] [ f ] if* split-groups ;
 
 : group-flow ( seq -- newseq )
     [

basis/stack-checker/known-words/known-words.factor

@@ -173,15 +173,13 @@ do-primitive alien-invoke alien-indirect alien-callback
 { call execute dispatch load-locals get-local drop-locals }
 [ t "no-compile" set-word-prop ] each
 
-SYMBOL: +primitive+
-
 : non-inline-word ( word -- )
     dup called-dependency depends-on
     {
         { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
         { [ dup "special" word-prop ] [ infer-special ] }
-        { [ dup +primitive+ word-prop ] [ infer-primitive ] }
+        { [ dup "primitive" word-prop ] [ infer-primitive ] }
-        { [ dup +transform-quot+ word-prop ] [ apply-transform ] }
+        { [ dup "transform-quot" word-prop ] [ apply-transform ] }
         { [ dup "macro" word-prop ] [ apply-macro ] }
         { [ dup "cannot-infer" word-prop ] [ cannot-infer-effect ] }
         { [ dup "inferred-effect" word-prop ] [ cached-infer ] }
@@ -190,7 +188,7 @@ SYMBOL: +primitive+
     } cond ;
 
 : define-primitive ( word inputs outputs -- )
-    [ 2drop t +primitive+ set-word-prop ]
+    [ 2drop t "primitive" set-word-prop ]
     [ drop "input-classes" set-word-prop ]
     [ nip "default-output-classes" set-word-prop ]
     3tri ;
@@ -600,8 +598,6 @@ SYMBOL: +primitive+
 
 \ (set-os-envs) { array } { } define-primitive
 
-\ do-primitive [ \ do-primitive cannot-infer-effect ] "infer" set-word-prop
-
 \ dll-valid? { object } { object } define-primitive
 
 \ modify-code-heap { array object } { } define-primitive

basis/stack-checker/transforms/transforms.factor

@@ -8,9 +8,6 @@ stack-checker.backend stack-checker.state stack-checker.visitor
 stack-checker.errors ;
 IN: stack-checker.transforms
 
-SYMBOL: +transform-quot+
-SYMBOL: +transform-n+
-
 : give-up-transform ( word -- )
     dup recursive-label
     [ call-recursive-word ]
@@ -48,8 +45,8 @@ SYMBOL: +transform-n+
 : apply-transform ( word -- )
     [ inlined-dependency depends-on ] [
         [ ]
-        [ +transform-quot+ word-prop ]
+        [ "transform-quot" word-prop ]
-        [ +transform-n+ word-prop ]
+        [ "transform-n" word-prop ]
         tri
         (apply-transform)
     ] bi ;
@@ -64,8 +61,8 @@ SYMBOL: +transform-n+
     ] bi ;
 
 : define-transform ( word quot n -- )
-    [ drop +transform-quot+ set-word-prop ]
+    [ drop "transform-quot" set-word-prop ]
-    [ nip +transform-n+ set-word-prop ]
+    [ nip "transform-n" set-word-prop ]
     3bi ;
 
 ! Combinators

basis/tools/deploy/shaker/shaker.factor

@@ -85,8 +85,11 @@ IN: tools.deploy.shaker
     [
         strip-dictionary? [
             {
+                "cannot-infer"
                 "coercer"
+                "combination"
                 "compiled-effect"
+                "compiled-generic-uses"
                 "compiled-uses"
                 "constraints"
                 "declared-effect"
@@ -94,38 +97,52 @@ IN: tools.deploy.shaker
                 "default-method"
                 "default-output-classes"
                 "derived-from"
-                "identities"
+                "engines"
                 "if-intrinsics"
                 "infer"
                 "inferred-effect"
+                "inline"
+                "inlined-block"
                 "input-classes"
                 "interval"
                 "intrinsics"
+                "lambda"
                 "loc"
+                "local-reader"
+                "local-reader?"
+                "local-writer"
+                "local-writer?"
+                "local?"
+                "macro"
                 "members"
-                "methods"
+                "memo-quot"
                 "method-class"
                 "method-generic"
-                "combination"
+                "methods"
-                "cannot-infer"
                 "no-compile"
                 "optimizer-hooks"
-                "output-classes"
+                "outputs"
                 "participants"
                 "predicate"
                 "predicate-definition"
                 "predicating"
-                "tuple-dispatch-generic"
+                "reader"
-                "slots"
+                "reading"
+                "recursive"
+                "shuffle"
                 "slot-names"
+                "slots"
+                "special"
                 "specializer"
                 "step-into"
                 "step-into?"
                 "superclass"
-                "reading"
+                "transform-n"
-                "writing"
+                "transform-quot"
+                "tuple-dispatch-generic"
                 "type"
-                "engines"
+                "writer"
+                "writing"
             } %
         ] when
         
@@ -211,6 +228,7 @@ IN: tools.deploy.shaker
                 classes:update-map
                 command-line:main-vocab-hook
                 compiled-crossref
+                compiled-generic-crossref
                 compiler.units:recompile-hook
                 compiler.units:update-tuples-hook
                 definitions:crossref

basis/tools/deploy/test/1/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.1" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
-    { deploy-math? t }
     { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.1" }
     { deploy-io 2 }
-    { deploy-reflection 1 }
+    { deploy-random? f }
-    { deploy-ui? f }
+    { deploy-math? t }
+    { deploy-compiler? t }
+    { deploy-reflection 2 }
     { "stop-after-last-window?" t }
+    { deploy-threads? t }
+    { deploy-ui? f }
     { deploy-word-props? f }
+    { deploy-word-defs? f }
 }

basis/tools/deploy/test/2/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
+    { deploy-io 2 }
-    { deploy-compiler? t }
-    { deploy-reflection 2 }
     { deploy-ui? f }
-    { deploy-word-props? f }
     { deploy-threads? t }
     { deploy-c-types? f }
-    { deploy-random? f }
-    { "stop-after-last-window?" t }
     { deploy-name "tools.deploy.test.2" }
-    { deploy-io 2 }
+    { deploy-compiler? t }
+    { deploy-word-props? f }
+    { deploy-reflection 2 }
     { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/3/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.3" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
-    { deploy-math? t }
-    { deploy-c-types? f }
     { deploy-io 3 }
-    { deploy-reflection 1 }
     { deploy-ui? f }
-    { "stop-after-last-window?" t }
+    { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.3" }
+    { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/4/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
-    { deploy-reflection 1 }
     { deploy-io 2 }
-    { deploy-c-types? f }
-    { deploy-random? f }
     { deploy-ui? f }
-    { deploy-name "tools.deploy.test.4" }
-    { deploy-word-defs? f }
-    { "stop-after-last-window?" t }
     { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.4" }
     { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/deploy/test/5/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-math? t }
-    { deploy-reflection 1 }
     { deploy-io 3 }
-    { deploy-c-types? f }
-    { deploy-random? f }
     { deploy-ui? f }
-    { deploy-name "tools.deploy.test.5" }
-    { deploy-word-defs? f }
-    { "stop-after-last-window?" t }
     { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-name "tools.deploy.test.5" }
     { deploy-compiler? t }
     { deploy-word-props? f }
+    { deploy-reflection 2 }
+    { deploy-word-defs? f }
+    { "stop-after-last-window?" t }
+    { deploy-random? f }
+    { deploy-math? t }
 }

basis/tools/vocabs/browser/browser.factor

@@ -181,12 +181,12 @@ M: vocab-spec article-parent drop "vocab-index" ;
 M: vocab-tag >link ;
 
 M: vocab-tag article-title
-    vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
+    name>> "Vocabularies tagged ``" swap "''" 3append ;
 
-M: vocab-tag article-name vocab-tag-name ;
+M: vocab-tag article-name name>> ;
 
 M: vocab-tag article-content
-    \ $tagged-vocabs swap vocab-tag-name 2array ;
+    \ $tagged-vocabs swap name>> 2array ;
 
 M: vocab-tag article-parent drop "vocab-index" ;
 
@@ -195,12 +195,12 @@ M: vocab-tag summary article-title ;
 M: vocab-author >link ;
 
 M: vocab-author article-title
-    vocab-author-name "Vocabularies by " prepend ;
+    name>> "Vocabularies by " prepend ;
 
-M: vocab-author article-name vocab-author-name ;
+M: vocab-author article-name name>> ;
 
 M: vocab-author article-content
-    \ $authored-vocabs swap vocab-author-name 2array ;
+    \ $authored-vocabs swap name>> 2array ;
 
 M: vocab-author article-parent drop "vocab-index" ;
 

basis/tools/walker/debug/debug.factor

@@ -27,5 +27,5 @@ IN: tools.walker.debug
 
         p ?promise
         variables>> walker-continuation swap at
-        model-value data>>
+        value>> data>>
     ] ;

basis/tools/walker/walker.factor

@@ -163,7 +163,7 @@ SYMBOL: +stopped+
     ] change-frame ;
 
 : status ( -- symbol )
-    walker-status tget model-value ;
+    walker-status tget value>> ;
 
 : set-status ( symbol -- )
     walker-status tget set-model ;

basis/ui/freetype/freetype.factor

@@ -184,7 +184,7 @@ M: freetype-renderer string-height ( open-font string -- h )
 : draw-char ( open-font sprites char loc -- )
     GL_MODELVIEW [
         0 0 glTranslated
-        char-sprite sprite-dlist glCallList
+        char-sprite dlist>> glCallList
     ] do-matrix ;
 
 : char-widths ( open-font string -- widths )

basis/ui/gadgets/editors/editors.factor

@@ -55,9 +55,9 @@ M: editor ungraft*
     dup caret>> deactivate-editor-model
     dup mark>> deactivate-editor-model ;
 
-: editor-caret* ( editor -- loc ) caret>> model-value ;
+: editor-caret* ( editor -- loc ) caret>> value>> ;
 
-: editor-mark* ( editor -- loc ) mark>> model-value ;
+: editor-mark* ( editor -- loc ) mark>> value>> ;
 
 : set-caret ( loc editor -- )
     [ model>> validate-loc ] keep
@@ -501,7 +501,7 @@ TUPLE: field < wrapper field-model editor ;
         swap >>field-model ;
 
 M: field graft*
-    [ [ field-model>> model-value ] [ editor>> ] bi set-editor-string ]
+    [ [ field-model>> value>> ] [ editor>> ] bi set-editor-string ]
     [ dup editor>> model>> add-connection ]
     bi ;
 

basis/ui/gadgets/gadgets.factor

@@ -50,7 +50,7 @@ M: gadget model-changed 2drop ;
     dup model>> dup [ 2dup remove-connection ] when 2drop ;
 
 : control-value ( control -- value )
-    model>> model-value ;
+    model>> value>> ;
 
 : set-control-value ( value control -- )
     model>> set-model ;

basis/ui/gadgets/handler/handler.factor

@@ -8,4 +8,4 @@ TUPLE: handler < wrapper table ;
 : <handler> ( child -- handler ) handler new-wrapper ;
 
 M: handler handle-gesture ( gesture gadget -- ? )
-   over table>> at dup [ call f ] [ 2drop t ] if ;
+   tuck table>> at dup [ call f ] [ 2drop t ] if ;

basis/ui/gadgets/incremental/incremental.factor

@@ -41,7 +41,7 @@ M: incremental pref-dim*
     swap set-rect-loc ;
 
 : prefer-incremental ( gadget -- )
-    dup forget-pref-dim dup pref-dim swap set-rect-dim ;
+    dup forget-pref-dim dup pref-dim >>dim drop ;
 
 : add-incremental ( gadget incremental -- )
     not-in-layout

basis/ui/render/render.factor

@@ -138,7 +138,7 @@ M: polygon draw-interior
 
 : <polygon-gadget> ( color points -- gadget )
     dup max-dim
-    >r <polygon> <gadget> r> over set-rect-dim
+    >r <polygon> <gadget> r> >>dim
     [ (>>interior) ] keep ;
 
 ! Font rendering

basis/ui/tools/browser/browser.factor

@@ -39,17 +39,17 @@ M: browser-gadget ungraft*
 
 : showing-definition? ( defspec assoc -- ? )
     [ key? ] 2keep
-    [ >r dup word-link? [ link-name ] when r> key? ] 2keep
+    [ >r dup word-link? [ name>> ] when r> key? ] 2keep
     >r dup vocab-link? [ vocab ] when r> key?
     or or ;
 
 M: browser-gadget definitions-changed ( assoc browser -- )
     history>>
-    dup model-value rot showing-definition?
+    dup value>> rot showing-definition?
     [ notify-connections ] [ drop ] if ;
 
 : help-action ( browser-gadget -- link )
-    history>> model-value >link ;
+    history>> value>> >link ;
 
 : com-follow ( link -- ) browser-gadget call-tool ;
 

basis/ui/tools/debugger/debugger.factor

@@ -11,7 +11,7 @@ USING: accessors arrays ui ui.commands ui.gestures ui.gadgets
 IN: ui.tools.debugger
 
 : <restart-list> ( restarts restart-hook -- gadget )
-    [ restart-name ] rot <model> <list> ;
+    [ name>> ] rot <model> <list> ;
 
 TUPLE: debugger < track restarts ;
 

basis/ui/tools/search/search.factor

@@ -118,7 +118,7 @@ M: live-search pref-dim* drop { 400 200 } ;
 
 : <source-file-search> ( string files -- gadget )
     source-file-candidates
-    f [ pathname-string ] <live-search> ;
+    f [ string>> ] <live-search> ;
 
 : all-source-files ( -- seq )
     source-files get keys natural-sort ;
@@ -146,7 +146,7 @@ M: live-search pref-dim* drop { 400 200 } ;
 
 : <history-search> ( string seq -- gadget )
     history-candidates
-    f [ input-string ] <live-search> ;
+    f [ string>> ] <live-search> ;
 
 : listener-history ( listener -- seq )
     listener-gadget-input interactor-history <reversed> ;

basis/ui/tools/traceback/traceback.factor

@@ -9,15 +9,15 @@ USING: accessors continuations kernel models namespaces
 IN: ui.tools.traceback
 
 : <callstack-display> ( model -- gadget )
-    [ [ continuation-call callstack. ] when* ]
+    [ [ call>> callstack. ] when* ]
     t "Call stack" <labelled-pane> ;
 
 : <datastack-display> ( model -- gadget )
-    [ [ continuation-data stack. ] when* ]
+    [ [ data>> stack. ] when* ]
     t "Data stack" <labelled-pane> ;
 
 : <retainstack-display> ( model -- gadget )
-    [ [ continuation-retain stack. ] when* ]
+    [ [ retain>> stack. ] when* ]
     t "Retain stack" <labelled-pane> ;
 
 TUPLE: traceback-gadget < track ;
@@ -39,7 +39,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ;
     dup <toolbar> f track-add ;
 
 : <namestack-display> ( model -- gadget )
-    [ [ continuation-name namestack. ] when* ]
+    [ [ name>> namestack. ] when* ]
     <pane-control> ;
 
 : <variables-gadget> ( model -- gadget )

basis/ui/tools/walker/walker.factor

@@ -41,7 +41,7 @@ M: walker-gadget focusable-child*
 : walker-state-string ( status thread -- string )
     [
         "Thread: " %
-        dup thread-name %
+        dup name>> %
         " (" %
         swap {
             { +stopped+ "Stopped" }
@@ -92,7 +92,7 @@ walker-gadget "toolbar" f {
     [ swap walker-for-thread? ] curry find-window ;
 
 : walker-window ( status continuation thread -- )
-    [ <walker-gadget> ] [ thread-name ] bi open-status-window ;
+    [ <walker-gadget> ] [ name>> ] bi open-status-window ;
 
 [
     dup find-walker-window dup

core/assocs/assocs.factor

@@ -210,7 +210,7 @@ M: enum at*
 
 M: enum set-at seq>> set-nth ;
 
-M: enum delete-at enum-seq delete-nth ;
+M: enum delete-at seq>> delete-nth ;
 
 M: enum >alist ( enum -- alist )
     seq>> [ length ] keep zip ;

core/classes/mixin/mixin.factor

@@ -78,8 +78,8 @@ TUPLE: mixin-instance loc class mixin ;
 M: mixin-instance equal?
     {
         { [ over mixin-instance? not ] [ f ] }
-        { [ 2dup [ mixin-instance-class ] bi@ = not ] [ f ] }
+        { [ 2dup [ class>> ] bi@ = not ] [ f ] }
-        { [ 2dup [ mixin-instance-mixin ] bi@ = not ] [ f ] }
+        { [ 2dup [ mixin>> ] bi@ = not ] [ f ] }
         [ t ]
     } cond 2nip ;
 
@@ -91,15 +91,14 @@ M: mixin-instance hashcode*
         swap >>mixin
         swap >>class ;
 
-M: mixin-instance where mixin-instance-loc ;
+M: mixin-instance where loc>> ;
 
-M: mixin-instance set-where set-mixin-instance-loc ;
+M: mixin-instance set-where (>>loc) ;
 
 M: mixin-instance definer drop \ INSTANCE: f ;
 
 M: mixin-instance definition drop f ;
 
 M: mixin-instance forget*
-    dup mixin-instance-class
+    [ class>> ] [ mixin>> ] bi
-    swap mixin-instance-mixin dup mixin-class?
+    dup mixin-class? [ remove-mixin-instance ] [ 2drop ] if ;
-    [ remove-mixin-instance ] [ 2drop ] if ;

core/compiler/units/units.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel continuations assocs namespaces
 sequences words vocabs definitions hashtables init sets
-math.order classes classes.algebra ;
+math math.order classes classes.algebra ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -73,11 +73,20 @@ GENERIC: definitions-changed ( assoc obj -- )
 SYMBOL: outdated-tuples
 SYMBOL: update-tuples-hook
 
+: dependency>= ( how1 how2 -- ? )
+    [
+        {
+            called-dependency
+            flushed-dependency
+            inlined-dependency
+        } index
+    ] bi@ >= ;
+
 : strongest-dependency ( how1 how2 -- how )
-    [ called-dependency or ] bi@ max ;
+    [ called-dependency or ] bi@ [ dependency>= ] most ;
 
 : weakest-dependency ( how1 how2 -- how )
-    [ inlined-dependency or ] bi@ min ;
+    [ inlined-dependency or ] bi@ [ dependency>= not ] most ;
 
 : compiled-usage ( word -- assoc )
     compiled-crossref get at ;
@@ -89,7 +98,7 @@ SYMBOL: update-tuples-hook
     #! don't have to recompile words that folded this away.
     [ compiled-usage ]
     [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
-    [ after=? nip ] curry assoc-filter ;
+    [ dependency>= nip ] curry assoc-filter ;
 
 : compiled-usages ( assoc -- assocs )
     [ drop word? ] assoc-filter

core/continuations/continuations.factor

@@ -178,7 +178,7 @@ M: condition compute-restarts
     [ error>> compute-restarts ]
     [
         [ restarts>> ]
-        [ condition-continuation [ <restart> ] curry ] bi
+        [ continuation>> [ <restart> ] curry ] bi
         { } assoc>map
     ] bi append ;
 

core/definitions/definitions.factor

@@ -5,23 +5,9 @@ USING: kernel sequences namespaces assocs graphs math math.order ;
 
 ERROR: no-compilation-unit definition ;
 
-SINGLETON: inlined-dependency
+SYMBOL: inlined-dependency
-SINGLETON: flushed-dependency
+SYMBOL: flushed-dependency
-SINGLETON: called-dependency
+SYMBOL: called-dependency
-
-UNION: dependency
-inlined-dependency
-flushed-dependency
-called-dependency ;
-
-M: dependency <=>
-    [
-        {
-            called-dependency
-            flushed-dependency
-            inlined-dependency
-        } index
-    ] bi@ <=> ;
 
 SYMBOL: changed-definitions
 

core/io/encodings/encodings.factor

@@ -130,9 +130,9 @@ M: encoder stream-write1
 M: encoder stream-write
     >encoder< decoder-write ;
 
-M: encoder dispose encoder-stream dispose ;
+M: encoder dispose stream>> dispose ;
 
-M: encoder stream-flush encoder-stream stream-flush ;
+M: encoder stream-flush stream>> stream-flush ;
 
 INSTANCE: encoder plain-writer
 PRIVATE>

core/sorting/sorting-tests.factor

@@ -1,5 +1,5 @@
 USING: sorting sequences kernel math math.order random
-tools.test vectors sets ;
+tools.test vectors sets vocabs ;
 IN: sorting.tests
 
 [ { } ] [ { } natural-sort ] unit-test
@@ -24,3 +24,5 @@ unit-test
 
 [ { { 1 "a" } { 1 "b" } { 1 "c" } { 1 "e" } { 2 "d" } } ]
 [ { { 1 "a" } { 1 "b" } { 1 "c" } { 2 "d" } { 1 "e" } } sort-keys ] unit-test
+
+[ ] [ all-words natural-sort drop ] unit-test

core/source-files/source-files.factor

@@ -56,7 +56,7 @@ ERROR: invalid-source-file-path path ;
         ] [ 2drop ] if
     ] assoc-each ;
 
-M: pathname where pathname-string 1 2array ;
+M: pathname where string>> 1 2array ;
 
 : forget-source ( path -- )
     [
@@ -69,7 +69,7 @@ M: pathname where pathname-string 1 2array ;
     bi ;
 
 M: pathname forget*
-    pathname-string forget-source ;
+    string>> forget-source ;
 
 : rollback-source-file ( file -- )
     [

core/syntax/syntax.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays byte-vectors
+USING: accessors alien arrays byte-arrays byte-vectors
 definitions generic hashtables kernel math namespaces parser
 lexer sequences strings strings.parser sbufs vectors
 words quotations io assocs splitting classes.tuple
@@ -193,7 +193,7 @@ IN: bootstrap.syntax
         "))" parse-effect parsed
     ] define-syntax
 
-    "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
+    "MAIN:" [ scan-word in get vocab (>>main) ] define-syntax
 
     "<<" [
         [

core/vocabs/vocabs.factor

@@ -16,44 +16,78 @@ source-loaded? docs-loaded? ;
         swap >>name
         H{ } clone >>words ;
 
+GENERIC: vocab-name ( vocab-spec -- name )
+
 GENERIC: vocab ( vocab-spec -- vocab )
 
 M: vocab vocab ;
 
 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
 
+M: vocab vocab-name name>> ;
+
 M: string vocab-name ;
 
+GENERIC: vocab-words ( vocab-spec -- words )
+
+M: vocab vocab-words words>> ;
+
 M: object vocab-words vocab vocab-words ;
 
+M: f vocab-words ;
+
+GENERIC: vocab-help ( vocab-spec -- help )
+
+M: vocab vocab-help help>> ;
+
 M: object vocab-help vocab vocab-help ;
 
+M: f vocab-help ;
+
+GENERIC: vocab-main ( vocab-spec -- main )
+
+M: vocab vocab-main main>> ;
+
 M: object vocab-main vocab vocab-main ;
 
+M: f vocab-main ;
+
+GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
+
+M: vocab vocab-source-loaded? source-loaded?>> ;
+
 M: object vocab-source-loaded?
     vocab vocab-source-loaded? ;
 
+M: f vocab-source-loaded? ;
+
+GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
+
+M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
+
 M: object set-vocab-source-loaded?
     vocab set-vocab-source-loaded? ;
 
+M: f set-vocab-source-loaded? 2drop ;
+
+GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
+
+M: vocab vocab-docs-loaded? docs-loaded?>> ;
+
 M: object vocab-docs-loaded?
     vocab vocab-docs-loaded? ;
 
+M: f vocab-docs-loaded? ;
+
+GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
+
+M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
+
 M: object set-vocab-docs-loaded?
     vocab set-vocab-docs-loaded? ;
 
-M: f vocab-words ;
-
-M: f vocab-source-loaded? ;
-
-M: f set-vocab-source-loaded? 2drop ;
-
-M: f vocab-docs-loaded? ;
-
 M: f set-vocab-docs-loaded? 2drop ;
 
-M: f vocab-help ;
-
 : create-vocab ( name -- vocab )
     dictionary get [ <vocab> ] cache ;
 
@@ -90,10 +124,9 @@ TUPLE: vocab-link name ;
 : <vocab-link> ( name -- vocab-link )
     vocab-link boa ;
 
-M: vocab-link hashcode*
+M: vocab-link hashcode* name>> hashcode* ;
-    vocab-link-name hashcode* ;
 
-M: vocab-link vocab-name vocab-link-name ;
+M: vocab-link vocab-name name>> ;
 
 UNION: vocab-spec vocab vocab-link ;
 

extra/asn1/asn1.factor

@@ -54,7 +54,7 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
 
 : (set-tag) ( -- )
     elements get id>> 31 bitand
-    dup elements get set-element-tag
+    dup elements get (>>tag)
     31 < [
         [ "unsupported tag encoding: #{" % 
           get-id # "}" %
@@ -63,22 +63,22 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
 
 : set-tagclass ( -- )
     get-id -6 shift tag-classes nth
-    elements get set-element-tagclass ;
+    elements get (>>tagclass) ;
 
 : set-encoding ( -- )
     get-id HEX: 20 bitand
     zero? "primitive" "constructed" ?
-    elements get set-element-encoding ;
+    elements get (>>encoding) ;
 
 : set-content-length ( -- )
     read1
     dup 127 <= [ 
         127 bitand read be>
-    ] unless elements get set-element-contentlength ;
+    ] unless elements get (>>contentlength) ;
 
 : set-newobj ( -- )
     elements get contentlength>> read
-    elements get set-element-newobj ;
+    elements get (>>newobj) ;
 
 : set-objtype ( syntax -- )
     builtin-syntax 2array [
@@ -86,7 +86,7 @@ TUPLE: element syntax id tag tagclass encoding contentlength newobj objtype ;
         elements get encoding>> swap at
         elements get tag>>
         swap at [ 
-            elements get set-element-objtype
+            elements get (>>objtype)
         ] when*
     ] each ;
 
@@ -96,15 +96,15 @@ SYMBOL: end
 
 : (read-array) ( -- )
     elements get id>> [
-        elements get element-syntax read-ber
+        elements get syntax>> read-ber
         dup end = [ drop ] [ , (read-array) ] if
     ] when ;
 
 : read-array ( -- array ) [ (read-array) ] { } make ;
 
 : set-case ( -- object )
-    elements get element-newobj
+    elements get newobj>>
-    elements get element-objtype {
+    elements get objtype>> {
         { "boolean" [ "\0" = not ] }
         { "string" [ "" or ] }
         { "integer" [ be> ] }
@@ -112,7 +112,7 @@ SYMBOL: end
     } case ;
 
 : set-id ( -- boolean )
-    read1 dup elements get set-element-id ;
+    read1 dup elements get (>>id) ;
 
 : read-ber ( syntax -- object )
     element new
@@ -124,7 +124,7 @@ SYMBOL: end
         set-encoding
         set-content-length
         set-newobj
-        elements get element-syntax set-objtype
+        elements get syntax>> set-objtype
         set-case
     ] [ end ] if ;
 
@@ -181,7 +181,7 @@ TUPLE: tag value ;
     ] with-scope ; inline
 
 : set-tag ( value -- )
-    tagnum get set-tag-value ;
+    tagnum get (>>value) ;
 
 M: string >ber ( str -- byte-array )
     tagnum get tag-value 1array "C" pack-native swap dup

extra/benchmark/empty-loop-0/empty-loop-0.factor

@@ -5,6 +5,6 @@ IN: benchmark.empty-loop-0
     dup 0 fixnum< [ drop ] [ 1 fixnum-fast empty-loop-0 ] if ;
 
 : empty-loop-main ( -- )
-    5000000 empty-loop-0 ;
+    50000000 empty-loop-0 ;
 
 MAIN: empty-loop-main

extra/benchmark/empty-loop-1/empty-loop-1.factor

@@ -5,6 +5,6 @@ IN: benchmark.empty-loop-1
     [ drop ] each-integer ;
 
 : empty-loop-main ( -- )
-    5000000 empty-loop-1 ;
+    50000000 empty-loop-1 ;
 
 MAIN: empty-loop-main

extra/benchmark/empty-loop-2/empty-loop-2.factor

@@ -5,6 +5,6 @@ IN: benchmark.empty-loop-2
     [ drop ] each ;
 
 : empty-loop-main ( -- )
-    5000000 empty-loop-2 ;
+    50000000 empty-loop-2 ;
 
 MAIN: empty-loop-main

extra/benchmark/fib4/fib4.factor

@@ -1,7 +1,7 @@
 USING: accessors math kernel debugger ;
 IN: benchmark.fib4
 
-TUPLE: box i ;
+TUPLE: box { i read-only } ;
 
 C: <box> box
 
@@ -15,8 +15,8 @@ C: <box> box
         i>> 1- <box>
         tuple-fib
         swap i>> swap i>> + <box>
-    ] if ;
+    ] if ; inline recursive
 
-: fib-main ( -- ) T{ box f 34 } tuple-fib T{ box f 9227465 } assert= ;
+: fib-main ( -- ) T{ box f 34 } tuple-fib i>> 9227465 assert= ;
 
 MAIN: fib-main

extra/coroutines/coroutines.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2005 Chris Double, 2007 Clemens Hofreither.
 ! See http://factorcode.org/license.txt for BSD license.
+USING: kernel hashtables namespaces continuations quotations
+accessors ;
 IN: coroutines
-USING: kernel hashtables namespaces continuations quotations ;
 
 SYMBOL: current-coro
 
@@ -13,12 +14,12 @@ TUPLE: coroutine resumecc exitcc ;
   [ swapd , , \ bind , 
     "Coroutine has terminated illegally." , \ throw ,
   ] [ ] make
-  over set-coroutine-resumecc ;
+  >>resumecc ;
 
 : coresume ( v co -- result )
   [ 
-    over set-coroutine-exitcc
+    >>exitcc
-    coroutine-resumecc call
+    resumecc>> call
     #! At this point, the coroutine quotation must have terminated
     #! normally (without calling coyield or coterminate). This shouldn't happen.
     f over
@@ -31,8 +32,8 @@ TUPLE: coroutine resumecc exitcc ;
   current-coro get
   [  
     [ continue-with ] curry
-    over set-coroutine-resumecc  
+    >>resumecc
-    coroutine-exitcc continue-with
+    exitcc>> continue-with
   ] callcc1 2nip ;
 
 : coyield* ( v -- ) coyield drop ; inline
@@ -40,5 +41,5 @@ TUPLE: coroutine resumecc exitcc ;
 
 : coterminate ( v -- )
   current-coro get
-  [ ] over set-coroutine-resumecc
+  [ ] >>resumecc
-  coroutine-exitcc continue-with ;
+  exitcc>> continue-with ;

extra/db/sqlite/lib/lib.factor

@@ -5,7 +5,7 @@ namespaces sequences db.sqlite.ffi db combinators
 continuations db.types calendar.format serialize
 io.streams.byte-array byte-arrays io.encodings.binary
 io.backend db.errors present urls io.encodings.utf8
-io.encodings.string ;
+io.encodings.string accessors ;
 IN: db.sqlite.lib
 
 ERROR: sqlite-error < db-error n string ;
@@ -16,7 +16,7 @@ ERROR: sqlite-sql-error < sql-error n string ;
 
 : sqlite-statement-error ( -- * )
     SQLITE_ERROR
-    db get db-handle sqlite3_errmsg sqlite-sql-error ;
+    db get handle>> sqlite3_errmsg sqlite-sql-error ;
 
 : sqlite-check-result ( n -- )
     {

extra/db/sqlite/sqlite.factor

@@ -90,7 +90,7 @@ M: sqlite-statement bind-tuple ( tuple statement -- )
     ] keep bind-statement ;
 
 : last-insert-id ( -- id )
-    db get db-handle sqlite3_last_insert_rowid
+    db get handle>> sqlite3_last_insert_rowid
     dup zero? [ "last-id failed" throw ] when ;
 
 M: sqlite-db insert-tuple* ( tuple statement -- )

extra/db/tuples/tuples.factor

@@ -141,7 +141,7 @@ M: retryable execute-statement* ( statement type -- )
 
 : update-tuple ( tuple -- )
     dup class
-    db get db-update-statements [ <update-tuple-statement> ] cache
+    db get update-statements>> [ <update-tuple-statement> ] cache
     [ bind-tuple ] keep execute-statement ;
 
 : delete-tuples ( tuple -- )

extra/faq/faq.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: xml kernel sequences xml.utilities combinators.lib
 math xml.data arrays assocs xml.generator xml.writer namespaces
-math.parser io ;
+math.parser io accessors ;
 IN: faq
 
 : find-after ( seq quot -- elem after )
@@ -21,16 +21,16 @@ C: <q/a> q/a
     >r tag-children r> <q/a> ;
 
 : q/a>li ( q/a -- li )
-    [ q/a-question "strong" build-tag* f "br" build-tag* 2array ] keep
+    [ question>> "strong" build-tag* f "br" build-tag* 2array ] keep
-    q/a-answer append "li" build-tag* ;
+    answer>> append "li" build-tag* ;
 
 : xml>q/a ( xml -- q/a )
     [ "question" tag-named tag-children ] keep
     "answer" tag-named tag-children <q/a> ;
 
 : q/a>xml ( q/a -- xml )
-    [ q/a-question "question" build-tag* ] keep
+    [ question>> "question" build-tag* ] keep
-    q/a-answer "answer" build-tag*
+    answer>> "answer" build-tag*
     "\n" swap 3array "qa" build-tag* ;
 
 ! Lists of questions
@@ -43,23 +43,23 @@ C: <question-list> question-list
     <question-list> ;
 
 : question-list>xml ( question-list -- list )
-    [ question-list-seq [ q/a>xml "\n" swap 2array ]
+    [ seq>> [ q/a>xml "\n" swap 2array ]
       map concat "list" build-tag* ] keep
-    question-list-title [ "title" pick set-at ] when* ;
+    title>> [ "title" pick set-at ] when* ;
 
 : html>question-list ( h3 ol -- question-list )
     >r [ children>string ] [ f ] if* r>
     children-tags [ li>q/a ] map <question-list> ;
 
 : question-list>h3 ( id question-list -- h3 )
-    question-list-title [
+    title>> [
         "h3" build-tag
         swap number>string "id" pick set-at
     ] [ drop f ] if* ;
 
 : question-list>html ( question-list start id -- h3/f ol )
     -rot >r [ question-list>h3 ] keep
-    question-list-seq [ q/a>li ] map "ol" build-tag* r>
+    seq>> [ q/a>li ] map "ol" build-tag* r>
     number>string "start" pick set-at
     "margin-left: 5em" "style" pick set-at ;
 
@@ -72,32 +72,32 @@ C: <faq> faq
     first2 >r f prefix r> [ html>question-list ] 2map <faq> ;
 
 : header, ( faq -- )
-    dup faq-header ,
+    dup header>> ,
-    faq-lists first 1 -1 question-list>html nip , ;
+    lists>> first 1 -1 question-list>html nip , ;
 
 : br, ( -- )
     "br" contained, nl, ;
 
 : toc-link, ( question-list number -- )
     number>string "#" prepend "href" swap 2array 1array
-    "a" swap [ question-list-title , ] tag*, br, ;
+    "a" swap [ title>> , ] tag*, br, ;
 
 : toc, ( faq -- )
     "div" { { "style" "background-color: #eee; margin-left: 30%; margin-right: 30%; width: auto; padding: 5px; margin-top: 1em; margin-bottom: 1em" } } [
         "strong" [ "The big questions" , ] tag, br,
-        faq-lists rest dup length [ toc-link, ] 2each
+        lists>> rest dup length [ toc-link, ] 2each
     ] tag*, ;
 
 : faq-sections, ( question-lists -- )
-    unclip question-list-seq length 1+ dupd
+    unclip seq>> length 1+ dupd
-    [ question-list-seq length + ] accumulate nip
+    [ seq>> length + ] accumulate nip
     0 -rot [ pick question-list>html [ , nl, ] bi@ 1+ ] 2each drop ;
 
 : faq>html ( faq -- div )
     "div" [
         dup header,
         dup toc,
-        faq-lists faq-sections,
+        lists>> faq-sections,
     ] make-xml ;
 
 : xml>faq ( xml -- faq )
@@ -106,8 +106,8 @@ C: <faq> faq
 
 : faq>xml ( faq -- xml )
     "faq" [
-        "header" [ dup faq-header , ] tag,
+        "header" [ dup header>> , ] tag,
-        faq-lists [ question-list>xml , nl, ] each
+        lists>> [ question-list>xml , nl, ] each
     ] make-xml ;
 
 : read-write-faq ( xml-stream -- )

extra/ftp/server/server.factor

@@ -144,7 +144,7 @@ M: ftp-list service-command ( stream obj -- )
     150 "Opening BINARY mode data connection for "
     rot   
     [ file-name ] [
-        " " swap  file-info file-info-size number>string
+        " " swap  file-info size>> number>string
         "(" " bytes)." swapd 3append append
     ] bi 3append server-response ;
 

extra/math/blas/matrices/matrices-docs.factor

@@ -1,4 +1,4 @@
-USING: alien byte-arrays help.markup help.syntax math.blas.vectors sequences ;
+USING: alien byte-arrays help.markup help.syntax math math.blas.vectors sequences strings ;
 IN: math.blas.matrices
 
 ARTICLE: "math.blas-summary" "Basic Linear Algebra Subroutines (BLAS) interface"
@@ -52,13 +52,13 @@ ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
 { $subsection Mcols }
 { $subsection Msub }
 "Matrix-vector products:"
-{ $subsection n*M.V+n*V-in-place }
+{ $subsection n*M.V+n*V! }
 { $subsection n*M.V+n*V }
 { $subsection n*M.V }
 { $subsection M.V }
 "Vector outer products:"
-{ $subsection n*V(*)V+M-in-place }
+{ $subsection n*V(*)V+M! }
-{ $subsection n*V(*)Vconj+M-in-place }
+{ $subsection n*V(*)Vconj+M! }
 { $subsection n*V(*)V+M }
 { $subsection n*V(*)Vconj+M }
 { $subsection n*V(*)V }
@@ -66,12 +66,12 @@ ARTICLE: "math.blas.matrices" "BLAS interface matrix operations"
 { $subsection V(*) }
 { $subsection V(*)conj }
 "Matrix products:"
-{ $subsection n*M.M+n*M-in-place }
+{ $subsection n*M.M+n*M! }
 { $subsection n*M.M+n*M }
 { $subsection n*M.M }
 { $subsection M. }
 "Scalar-matrix products:"
-{ $subsection n*M-in-place }
+{ $subsection n*M! }
 { $subsection n*M }
 { $subsection M*n }
 { $subsection M/n } ;
@@ -111,134 +111,135 @@ HELP: double-complex-blas-matrix
 } related-words
 
 HELP: Mwidth
-{ $values { "matrix" "a BLAS matrix inherited from " { $link blas-matrix-base } } { "width" "The number of columns" } }
+{ $values { "matrix" blas-matrix-base } { "width" integer } }
 { $description "Returns the number of columns in " { $snippet "matrix" } "." } ;
 
 HELP: Mheight
-{ $values { "matrix" "a BLAS matrix inherited from " { $link blas-matrix-base } } { "width" "The number of columns" } }
+{ $values { "matrix" blas-matrix-base } { "height" integer } }
 { $description "Returns the number of rows in " { $snippet "matrix" } "." } ;
 
 { Mwidth Mheight } related-words
 
-HELP: n*M.V+n*V-in-place
+HELP: n*M.V+n*V!
-{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "beta" "a number" } { "y" "an M-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "y=alpha*A.x+b*y" blas-vector-base } }
 { $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } ", and overwrite the current contents of " { $snippet "y" } " with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." }
 { $side-effects "y" } ;
 
-HELP: n*V(*)V+M-in-place
+HELP: n*V(*)V+M!
-{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)y+A" blas-matrix-base } }
 { $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGER and xGERU routines in BLAS." }
 { $side-effects "A" } ;
 
-HELP: n*V(*)Vconj+M-in-place
+HELP: n*V(*)Vconj+M!
-{ $values { "alpha" "a number" } { "x" "an M-element complex BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element complex BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column complex BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "A=alpha*x(*)yconj+A" blas-matrix-base } }
 { $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and overwrite the current contents of A with the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". Corresponds to the xGERC routines in BLAS." }
 { $side-effects "A" } ;
 
-HELP: n*M.M+n*M-in-place
+HELP: n*M.M+n*M!
-{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "beta" "a number" } { "C" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "C=alpha*A.B+beta*C" blas-matrix-base } }
-{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
+{ $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." }
+{ $side-effects "C" } ;
 
 HELP: <empty-matrix>
-{ $values { "rows" "the number of rows the new matrix will have" } { "cols" "the number of columns the new matrix will have" } { "exemplar" "A BLAS vector inherited from " { $link blas-vector-base } " or BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "rows" integer } { "cols" integer } { "exemplar" blas-vector-base blas-matrix-base } { "matrix" blas-matrix-base } }
 { $description "Create a matrix of all zeros with the given dimensions and the same element type as " { $snippet "exemplar" } "." } ;
 
 { <zero-vector> <empty-vector> <empty-matrix> } related-words
 
 HELP: n*M.V+n*V
-{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "beta" "a number" } { "y" "an M-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "beta" number } { "y" blas-vector-base } { "alpha*A.x+b*y" blas-vector-base } }
 { $description "Calculate the matrix-vector product " { $snippet "αAx + βy" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ", and the height must match the length of " { $snippet "y" } ". The returned vector will have the same length as " { $snippet "y" } ". Corresponds to the xGEMV routines in BLAS." } ;
 
 HELP: n*V(*)V+M
-{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)y+A" blas-matrix-base } }
 { $description "Calculate the outer product " { $snippet "αx⊗y + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
 
 HELP: n*V(*)Vconj+M
-{ $values { "alpha" "a number" } { "x" "an M-element complex BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element complex BLAS vector inherited from " { $link blas-vector-base } } { "A" "an M-row, N-column complex BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "A" blas-matrix-base } { "alpha*x(*)yconj+A" blas-matrix-base } }
 { $description "Calculate the conjugate outer product " { $snippet "αx⊗y̅ + A" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "y" } ", and its height must match the length of " { $snippet "x" } ". The returned matrix will have the same dimensions as " { $snippet "A" } ". Corresponds to the xGERC routines in BLAS." } ;
 
 HELP: n*M.M+n*M
-{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "beta" "a number" } { "C" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "beta" number } { "C" blas-matrix-base } { "alpha*A.B+beta*C" blas-matrix-base } }
 { $description "Calculate the matrix product " { $snippet "αAB + βC" } " and overwrite the current contents of C with the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match, as must the heights of " { $snippet "A" } " and " { $snippet "C" } ", and the widths of " { $snippet "B" } " and " { $snippet "C" } ". Corresponds to the xGEMM routines in BLAS." } ;
 
 HELP: n*M.V
-{ $values { "alpha" "a number" } { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "x" blas-vector-base } { "alpha*A.x" blas-vector-base } }
 { $description "Calculate the matrix-vector product " { $snippet "αAx" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
 
 HELP: M.V
-{ $values { "A" "an M-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } { "x" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "A" blas-matrix-base } { "x" blas-vector-base } { "A.x" blas-vector-base } }
 { $description "Calculate the matrix-vector product " { $snippet "Ax" } " and return a freshly allocated vector containing the result. The width of " { $snippet "A" } " must match the length of " { $snippet "x" } ". The length of the returned vector will match the height of " { $snippet "A" } ". Corresponds to the xGEMV routines in BLAS." } ;
 
-{ n*M.V+n*V-in-place n*M.V+n*V n*M.V M.V } related-words
+{ n*M.V+n*V! n*M.V+n*V n*M.V M.V } related-words
 
 HELP: n*V(*)V
-{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)y" blas-matrix-base } }
 { $description "Calculate the outer product " { $snippet "αx⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
 
 HELP: n*V(*)Vconj
-{ $values { "alpha" "a number" } { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x(*)yconj" blas-matrix-base } }
 { $description "Calculate the outer product " { $snippet "αx⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
 
 HELP: V(*)
-{ $values { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)y" blas-matrix-base } }
 { $description "Calculate the outer product " { $snippet "x⊗y" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGER and xGERU routines in BLAS." } ;
 
 HELP: V(*)conj
-{ $values { "x" "an M-element BLAS vector inherited from " { $link blas-vector-base } } { "y" "an N-element BLAS vector inherited from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x(*)yconj" blas-matrix-base } }
 { $description "Calculate the conjugate outer product " { $snippet "x⊗y̅" } " and return a freshly allocated matrix containing the result. The returned matrix's height will match the length of " { $snippet "x" } ", and its width will match the length of " { $snippet "y" } ". Corresponds to the xGERC routines in BLAS." } ;
 
-{ n*V(*)V+M-in-place n*V(*)Vconj+M-in-place n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words
+{ n*V(*)V+M! n*V(*)Vconj+M! n*V(*)V+M n*V(*)Vconj+M n*V(*)V n*V(*)Vconj V(*) V(*)conj V. V.conj } related-words
 
 HELP: n*M.M
-{ $values { "alpha" "a number" } { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "alpha" number } { "A" blas-matrix-base } { "B" blas-matrix-base } { "alpha*A.B" blas-matrix-base } }
 { $description "Calculate the matrix product " { $snippet "αAB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
 
 HELP: M.
-{ $values { "A" "an M-row, K-column BLAS matrix inherited from " { $link blas-matrix-base } } { "B" "a K-row, N-column BLAS matrix inherited from " { $link blas-matrix-base } } }
+{ $values { "A" blas-matrix-base } { "B" blas-matrix-base } { "A.B" blas-matrix-base } }
 { $description "Calculate the matrix product " { $snippet "AB" } " and return a freshly allocated matrix containing the result. The width of " { $snippet "A" } " and the height of " { $snippet "B" } " must match. The returned matrix's height will be the same as " { $snippet "A" } "'s, and its width will match " { $snippet "B" } "'s. Corresponds to the xGEMM routines in BLAS." } ;
 
-{ n*M.M+n*M-in-place n*M.M+n*M n*M.M M. } related-words
+{ n*M.M+n*M! n*M.M+n*M n*M.M M. } related-words
 
 HELP: Msub
-{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "row" "The topmost row of the slice" } { "col" "The leftmost column of the slice" } { "height" "The height of the slice" } { "width" "The width of the slice" } }
+{ $values { "matrix" blas-matrix-base } { "row" integer } { "col" integer } { "height" integer } { "width" integer } { "sub" blas-matrix-base } }
 { $description "Select a rectangular submatrix of " { $snippet "matrix" } " with the given dimensions. The returned submatrix will share the parent matrix's storage." } ;
 
 HELP: Mrows
-{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "A" blas-matrix-base } { "rows" sequence } }
 { $description "Return a sequence of BLAS vectors representing the rows of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
 
 HELP: Mcols
-{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "A" blas-matrix-base } { "cols" sequence } }
 { $description "Return a sequence of BLAS vectors representing the columns of " { $snippet "matrix" } ". Each vector will share the parent matrix's storage." } ;
 
-HELP: n*M-in-place
+HELP: n*M!
-{ $values { "n" "a number" } { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "n" number } { "A" blas-matrix-base } { "A=n*A" blas-matrix-base } }
 { $description "Calculate the scalar-matrix product " { $snippet "nA" } " and overwrite the current contents of A with the result." }
 { $side-effects "A" } ;
 
 HELP: n*M
-{ $values { "n" "a number" } { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "n" number } { "A" blas-matrix-base } { "n*A" blas-matrix-base } }
 { $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
 
 HELP: M*n
-{ $values { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "n" "a number" } }
+{ $values { "A" blas-matrix-base } { "n" number } { "A*n" blas-matrix-base } }
 { $description "Calculate the scalar-matrix product " { $snippet "nA" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
 
 HELP: M/n
-{ $values { "A" "A BLAS matrix inheriting from " { $link blas-matrix-base } } { "n" "a number" } }
+{ $values { "A" blas-matrix-base } { "n" number } { "A/n" blas-matrix-base } }
 { $description "Calculate the scalar-matrix product " { $snippet "(1/n)A" } " and return a freshly allocated matrix with the same dimensions as " { $snippet "A" } " containing the result." } ;
 
-{ n*M-in-place n*M M*n M/n } related-words
+{ n*M! n*M M*n M/n } related-words
 
 HELP: Mtranspose
-{ $values { "matrix" "A BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "matrix" blas-matrix-base } { "matrix^T" blas-matrix-base } }
 { $description "Returns the transpose of " { $snippet "matrix" } ". The returned matrix shares storage with the original matrix." } ;
 
 HELP: element-type
-{ $values { "v" "a BLAS vector inheriting from " { $link blas-vector-base } ", or a BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "v" blas-vector-base blas-matrix-base } { "type" string } }
 { $description "Return the C type of the elements in the given BLAS vector or matrix." } ;
 
 HELP: <empty-vector>
-{ $values { "length" "The length of the new vector" } { "exemplar" "a BLAS vector inheriting from " { $link blas-vector-base } ", or a BLAS matrix inheriting from " { $link blas-matrix-base } } }
+{ $values { "length" "The length of the new vector" } { "exemplar" blas-vector-base blas-matrix-base } { "vector" blas-vector-base } }
-{ $description "Return a vector of zeros with the given length and the same element type as " { $snippet "v" } "." } ;
+{ $description "Return a vector of zeros with the given " { $snippet "length" } " and the same element type as " { $snippet "v" } "." } ;
 

extra/math/blas/matrices/matrices.factor

@@ -153,41 +153,45 @@ PRIVATE>
     [ (flatten-complex-sequence) >c-double-array ] (>matrix)
     <double-complex-blas-matrix> ;
 
-GENERIC: n*M.V+n*V-in-place ( alpha A x beta y -- y=alpha*A.x+b*y )
+GENERIC: n*M.V+n*V! ( alpha A x beta y -- y=alpha*A.x+b*y )
-GENERIC: n*V(*)V+M-in-place ( alpha x y A -- A=alpha*x(*)y+A )
+GENERIC: n*V(*)V+M! ( alpha x y A -- A=alpha*x(*)y+A )
-GENERIC: n*V(*)Vconj+M-in-place ( alpha x y A -- A=alpha*x(*)yconj+A )
+GENERIC: n*V(*)Vconj+M! ( alpha x y A -- A=alpha*x(*)yconj+A )
-GENERIC: n*M.M+n*M-in-place ( alpha A B beta C -- C=alpha*A.B+beta*C )
+GENERIC: n*M.M+n*M! ( alpha A B beta C -- C=alpha*A.B+beta*C )
 
-METHOD: n*M.V+n*V-in-place { real float-blas-matrix float-blas-vector real float-blas-vector }
+METHOD: n*M.V+n*V! { real float-blas-matrix float-blas-vector real float-blas-vector }
     [ ] (prepare-gemv) [ cblas_sgemv ] dip ;
-METHOD: n*M.V+n*V-in-place { real double-blas-matrix double-blas-vector real double-blas-vector }
+METHOD: n*M.V+n*V! { real double-blas-matrix double-blas-vector real double-blas-vector }
     [ ] (prepare-gemv) [ cblas_dgemv ] dip ;
-METHOD: n*M.V+n*V-in-place { number float-complex-blas-matrix float-complex-blas-vector number float-complex-blas-vector }
+METHOD: n*M.V+n*V! { number float-complex-blas-matrix float-complex-blas-vector number float-complex-blas-vector }
     [ (>c-complex) ] (prepare-gemv) [ cblas_cgemv ] dip ;
-METHOD: n*M.V+n*V-in-place { number double-complex-blas-matrix double-complex-blas-vector number double-complex-blas-vector }
+METHOD: n*M.V+n*V! { number double-complex-blas-matrix double-complex-blas-vector number double-complex-blas-vector }
     [ (>z-complex) ] (prepare-gemv) [ cblas_zgemv ] dip ;
 
-METHOD: n*V(*)V+M-in-place { real float-blas-vector float-blas-vector float-blas-matrix }
+METHOD: n*V(*)V+M! { real float-blas-vector float-blas-vector float-blas-matrix }
     [ ] (prepare-ger) [ cblas_sger ] dip ;
-METHOD: n*V(*)V+M-in-place { real double-blas-vector double-blas-vector double-blas-matrix }
+METHOD: n*V(*)V+M! { real double-blas-vector double-blas-vector double-blas-matrix }
     [ ] (prepare-ger) [ cblas_dger ] dip ;
-METHOD: n*V(*)V+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
+METHOD: n*V(*)V+M! { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
     [ (>c-complex) ] (prepare-ger) [ cblas_cgeru ] dip ;
-METHOD: n*V(*)V+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
+METHOD: n*V(*)V+M! { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
     [ (>z-complex) ] (prepare-ger) [ cblas_zgeru ] dip ;
 
-METHOD: n*V(*)Vconj+M-in-place { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
+METHOD: n*V(*)Vconj+M! { real float-blas-vector float-blas-vector float-blas-matrix }
+    [ ] (prepare-ger) [ cblas_sger ] dip ;
+METHOD: n*V(*)Vconj+M! { real double-blas-vector double-blas-vector double-blas-matrix }
+    [ ] (prepare-ger) [ cblas_dger ] dip ;
+METHOD: n*V(*)Vconj+M! { number float-complex-blas-vector float-complex-blas-vector float-complex-blas-matrix }
     [ (>c-complex) ] (prepare-ger) [ cblas_cgerc ] dip ;
-METHOD: n*V(*)Vconj+M-in-place { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
+METHOD: n*V(*)Vconj+M! { number double-complex-blas-vector double-complex-blas-vector double-complex-blas-matrix }
     [ (>z-complex) ] (prepare-ger) [ cblas_zgerc ] dip ;
 
-METHOD: n*M.M+n*M-in-place { real float-blas-matrix float-blas-matrix real float-blas-matrix }
+METHOD: n*M.M+n*M! { real float-blas-matrix float-blas-matrix real float-blas-matrix }
     [ ] (prepare-gemm) [ cblas_sgemm ] dip ;
-METHOD: n*M.M+n*M-in-place { real double-blas-matrix double-blas-matrix real double-blas-matrix }
+METHOD: n*M.M+n*M! { real double-blas-matrix double-blas-matrix real double-blas-matrix }
     [ ] (prepare-gemm) [ cblas_dgemm ] dip ;
-METHOD: n*M.M+n*M-in-place { number float-complex-blas-matrix float-complex-blas-matrix number float-complex-blas-matrix }
+METHOD: n*M.M+n*M! { number float-complex-blas-matrix float-complex-blas-matrix number float-complex-blas-matrix }
     [ (>c-complex) ] (prepare-gemm) [ cblas_cgemm ] dip ;
-METHOD: n*M.M+n*M-in-place { number double-complex-blas-matrix double-complex-blas-matrix number double-complex-blas-matrix }
+METHOD: n*M.M+n*M! { number double-complex-blas-matrix double-complex-blas-matrix number double-complex-blas-matrix }
     [ (>z-complex) ] (prepare-gemm) [ cblas_zgemm ] dip ;
 
 ! XXX should do a dense clone
@@ -206,36 +210,36 @@ syntax:M: blas-matrix-base clone
     [ f swap (blas-matrix-like) ] 3tri ;
 
 : n*M.V+n*V ( alpha A x beta y -- alpha*A.x+b*y )
-    clone n*M.V+n*V-in-place ;
+    clone n*M.V+n*V! ;
 : n*V(*)V+M ( alpha x y A -- alpha*x(*)y+A )
-    clone n*V(*)V+M-in-place ;
+    clone n*V(*)V+M! ;
 : n*V(*)Vconj+M ( alpha x y A -- alpha*x(*)yconj+A )
-    clone n*V(*)Vconj+M-in-place ;
+    clone n*V(*)Vconj+M! ;
 : n*M.M+n*M ( alpha A B beta C -- alpha*A.B+beta*C )
-    clone n*M.M+n*M-in-place ;
+    clone n*M.M+n*M! ;
 
 : n*M.V ( alpha A x -- alpha*A.x )
     1.0 2over [ Mheight ] dip <empty-vector>
-    n*M.V+n*V-in-place ; inline
+    n*M.V+n*V! ; inline
 
 : M.V ( A x -- A.x )
     1.0 -rot n*M.V ; inline
 
-: n*V(*)V ( n x y -- n*x(*)y )
+: n*V(*)V ( alpha x y -- alpha*x(*)y )
     2dup [ length>> ] bi@ pick <empty-matrix>
-    n*V(*)V+M-in-place ;
+    n*V(*)V+M! ;
-: n*V(*)Vconj ( n x y -- n*x(*)yconj )
+: n*V(*)Vconj ( alpha x y -- alpha*x(*)yconj )
     2dup [ length>> ] bi@ pick <empty-matrix>
-    n*V(*)Vconj+M-in-place ;
+    n*V(*)Vconj+M! ;
 
 : V(*) ( x y -- x(*)y )
     1.0 -rot n*V(*)V ; inline
 : V(*)conj ( x y -- x(*)yconj )
     1.0 -rot n*V(*)Vconj ; inline
 
-: n*M.M ( n A B -- n*A.B )
+: n*M.M ( alpha A B -- alpha*A.B )
     2dup [ Mheight ] [ Mwidth ] bi* pick <empty-matrix> 
-    1.0 swap n*M.M+n*M-in-place ;
+    1.0 swap n*M.M+n*M! ;
 
 : M. ( A B -- A.B )
     1.0 -rot n*M.M ; inline
@@ -247,7 +251,7 @@ syntax:M: blas-matrix-base clone
     height
     width ;
 
-: Msub ( matrix row col height width -- submatrix )
+: Msub ( matrix row col height width -- sub )
     5 npick dup transpose>>
     [ nip [ [ swap ] 2dip swap ] when (Msub) ] 2keep
     swap (blas-matrix-like) ;
@@ -281,14 +285,14 @@ syntax:M: blas-matrix-rowcol-sequence nth-unsafe
 
 : Mrows ( A -- rows )
     dup transpose>> [ (Mcols) ] [ (Mrows) ] if ;
-: Mcols ( A -- rows )
+: Mcols ( A -- cols )
     dup transpose>> [ (Mrows) ] [ (Mcols) ] if ;
 
-: n*M-in-place ( n A -- A=n*A )
+: n*M! ( n A -- A=n*A )
-    [ (Mcols) [ n*V-in-place drop ] with each ] keep ;
+    [ (Mcols) [ n*V! drop ] with each ] keep ;
 
 : n*M ( n A -- n*A )
-    clone n*M-in-place ; inline
+    clone n*M! ; inline
 
 : M*n ( A n -- A*n )
     swap n*M ; inline

extra/math/blas/vectors/vectors-docs.factor

@@ -1,4 +1,4 @@
-USING: alien byte-arrays help.markup help.syntax sequences ;
+USING: alien byte-arrays help.markup help.syntax math sequences ;
 IN: math.blas.vectors
 
 ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
@@ -11,13 +11,13 @@ ARTICLE: "math.blas.vectors" "BLAS interface vector operations"
 { $subsection Viamax }
 { $subsection Vamax }
 "Scalar-vector products:"
-{ $subsection n*V-in-place }
+{ $subsection n*V! }
 { $subsection n*V }
 { $subsection V*n }
 { $subsection V/n }
 { $subsection Vneg }
 "Vector addition:" 
-{ $subsection n*V+V-in-place }
+{ $subsection n*V+V! }
 { $subsection n*V+V }
 { $subsection V+ }
 { $subsection V- }
@@ -51,81 +51,81 @@ HELP: float-complex-blas-vector
 HELP: double-complex-blas-vector
 { $class-description "A vector of single-precision floating-point complex values. Complex values are stored in memory as two consecutive float values, real part then imaginary part. For details on the tuple layout, see " { $link blas-vector-base } "." } ;
 
-HELP: n*V+V-in-place
+HELP: n*V+V!
-{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "y=alpha*x+y" blas-vector-base } }
 { $description "Calculate the vector sum " { $snippet "αx + y" } " and replace the existing contents of y with the result. Corresponds to the xAXPY routines in BLAS." }
 { $side-effects "y" } ;
 
-HELP: n*V-in-place
+HELP: n*V!
-{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "x=alpha*x" blas-vector-base } }
 { $description "Calculate the scalar-vector product " { $snippet "αx" } " and replace the existing contents of x with the result. Corresponds to the xSCAL routines in BLAS." }
 { $side-effects "x" } ;
 
 HELP: V.
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x.y" number } }
 { $description "Calculate the inner product " { $snippet "x⋅y" } ". Corresponds to the xDOT and xDOTU routines in BLAS." } ;
 
 HELP: V.conj
-{ $values { "x" "a complex BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a complex BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "xconj.y" number } }
 { $description "Calculate the conjugate inner product " { $snippet "x̅⋅y" } ". Corresponds to the xDOTC routines in BLAS." } ;
 
 HELP: Vnorm
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "norm" number } }
 { $description "Calculate the norm-2, i.e., the magnitude or absolute value, of " { $snippet "x" } " (" { $snippet "‖x‖₂" } "). Corresponds to the xNRM2 routines in BLAS." } ;
 
 HELP: Vasum
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "sum" number } }
 { $description "Calculate the sum of the norm-1s of the elements of " { $snippet "x" } " (" { $snippet "Σ ‖xᵢ‖₁" } "). Corresponds to the xASUM routines in BLAS." } ;
 
 HELP: Vswap
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x=y" blas-vector-base } { "y=x" blas-vector-base } }
 { $description "Swap the contents of " { $snippet "x" } " and " { $snippet "y" } " in place. Corresponds to the xSWAP routines in BLAS." }
 { $side-effects "x" "y" } ;
 
 HELP: Viamax
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "max-i" integer } }
 { $description "Return the index of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the smallest index. Corresponds to the IxAMAX routines in BLAS." } ;
 
 HELP: Vamax
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "max" number } }
 { $description "Return the value of the element in " { $snippet "x" } " with the largest norm-1. If more than one element has the same norm-1, returns the first element. Corresponds to the IxAMAX routines in BLAS." } ;
 
 { Viamax Vamax } related-words
 
 HELP: <zero-vector>
-{ $values { "exemplar" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "exemplar" blas-vector-base } { "zero" blas-vector-base } }
 { $description "Return a vector of zeros with the same length and element type as " { $snippet "v" } ". The vector is constructed with an " { $snippet "inc" } " of zero, so it is not suitable for receiving results from BLAS functions; it is intended to be used as a term in other vector calculations. To construct an empty vector that can be used to receive results, see " { $link <empty-vector> } "." } ;
 
 HELP: n*V+V
-{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "alpha" number } { "x" blas-vector-base } { "y" blas-vector-base } { "alpha*x+y" blas-vector-base } }
 { $description "Calculate the vector sum " { $snippet "αx + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
 
 HELP: n*V
-{ $values { "alpha" "a number" } { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "alpha" "a number" } { "x" blas-vector-base } { "alpha*x" blas-vector-base } }
 { $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
 
 HELP: V+
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x+y" blas-vector-base } }
 { $description "Calculate the vector sum " { $snippet "x + y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
 
 HELP: V-
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "y" blas-vector-base } { "x-y" blas-vector-base } }
 { $description "Calculate the vector difference " { $snippet "x – y" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result. Corresponds to the xAXPY routines in BLAS." } ;
 
 HELP: Vneg
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "y" "a BLAS vector inheriting from " { $link blas-vector-base } } }
+{ $values { "x" blas-vector-base } { "-x" blas-vector-base } }
-{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " and " { $snippet "y" } " containing the result." } ;
+{ $description "Negate the elements of " { $snippet "x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result." } ;
 
 HELP: V*n
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "alpha" "a number" } }
+{ $values { "x" blas-vector-base } { "alpha" number } { "x*alpha" blas-vector-base } }
 { $description "Calculate the scalar-vector product " { $snippet "αx" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
 
 HELP: V/n
-{ $values { "x" "a BLAS vector inheriting from " { $link blas-vector-base } } { "alpha" "a number" } }
+{ $values { "x" blas-vector-base } { "alpha" number } { "x/alpha" blas-vector-base } }
 { $description "Calculate the scalar-vector product " { $snippet "(1/α)x" } " and return a freshly-allocated vector with the same length as " { $snippet "x" } " containing the result. Corresponds to the xSCAL routines in BLAS." } ;
 
-{ n*V+V-in-place n*V-in-place n*V+V n*V V+ V- Vneg V*n V/n } related-words
+{ n*V+V! n*V! n*V+V n*V V+ V- Vneg V*n V/n } related-words
 
 HELP: Vsub
-{ $values { "v" "a BLAS vector inheriting from " { $link blas-vector-base } } { "start" "The index of the first element of the slice" } { "length" "The length of the slice" } }
+{ $values { "v" blas-vector-base } { "start" integer } { "length" integer } { "sub" blas-vector-base } }
-{ $description "Slice a subvector out of " { $snippet "v" } " with the given length. The subvector will share storage with the parent vector." } ;
+{ $description "Slice a subvector out of " { $snippet "v" } " starting at " { $snippet "start" } " with the given " { $snippet "length" } ". The subvector will share storage with the parent vector." } ;

extra/math/blas/vectors/vectors.factor

@@ -21,8 +21,8 @@ C: <double-blas-vector> double-blas-vector
 C: <float-complex-blas-vector> float-complex-blas-vector
 C: <double-complex-blas-vector> double-complex-blas-vector
 
-GENERIC: n*V+V-in-place ( alpha x y -- y=alpha*x+y )
+GENERIC: n*V+V! ( alpha x y -- y=alpha*x+y )
-GENERIC: n*V-in-place   ( alpha x -- x=alpha*x )
+GENERIC: n*V!   ( alpha x -- x=alpha*x )
 
 GENERIC: V. ( x y -- x.y )
 GENERIC: V.conj ( x y -- xconj.y )
@@ -202,30 +202,30 @@ METHOD: Vswap { float-complex-blas-vector float-complex-blas-vector }
 METHOD: Vswap { double-complex-blas-vector double-complex-blas-vector }
     (prepare-swap) [ cblas_zswap ] 2dip ;
 
-METHOD: n*V+V-in-place { real float-blas-vector float-blas-vector }
+METHOD: n*V+V! { real float-blas-vector float-blas-vector }
     (prepare-axpy) [ cblas_saxpy ] dip ;
-METHOD: n*V+V-in-place { real double-blas-vector double-blas-vector }
+METHOD: n*V+V! { real double-blas-vector double-blas-vector }
     (prepare-axpy) [ cblas_daxpy ] dip ;
-METHOD: n*V+V-in-place { number float-complex-blas-vector float-complex-blas-vector }
+METHOD: n*V+V! { number float-complex-blas-vector float-complex-blas-vector }
     [ (>c-complex) ] 2dip
     (prepare-axpy) [ cblas_caxpy ] dip ;
-METHOD: n*V+V-in-place { number double-complex-blas-vector double-complex-blas-vector }
+METHOD: n*V+V! { number double-complex-blas-vector double-complex-blas-vector }
     [ (>z-complex) ] 2dip
     (prepare-axpy) [ cblas_zaxpy ] dip ;
 
-METHOD: n*V-in-place { real float-blas-vector }
+METHOD: n*V! { real float-blas-vector }
     (prepare-scal) [ cblas_sscal ] dip ;
-METHOD: n*V-in-place { real double-blas-vector }
+METHOD: n*V! { real double-blas-vector }
     (prepare-scal) [ cblas_dscal ] dip ;
-METHOD: n*V-in-place { number float-complex-blas-vector }
+METHOD: n*V! { number float-complex-blas-vector }
     [ (>c-complex) ] dip
     (prepare-scal) [ cblas_cscal ] dip ;
-METHOD: n*V-in-place { number double-complex-blas-vector }
+METHOD: n*V! { number double-complex-blas-vector }
     [ (>z-complex) ] dip
     (prepare-scal) [ cblas_zscal ] dip ;
 
-: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V-in-place ; inline
+: n*V+V ( alpha x y -- alpha*x+y ) clone n*V+V! ; inline
-: n*V ( alpha x -- alpha*x ) clone n*V-in-place ; inline
+: n*V ( alpha x -- alpha*x ) clone n*V! ; inline
 
 : V+ ( x y -- x+y )
     1.0 -rot n*V+V ; inline
@@ -251,6 +251,10 @@ METHOD: V. { double-complex-blas-vector double-complex-blas-vector }
     (prepare-dot)
     "CBLAS_Z" <c-object> [ cblas_zdotu_sub ] keep (z-complex>) ;
 
+METHOD: V.conj { float-blas-vector float-blas-vector }
+    (prepare-dot) cblas_sdot ;
+METHOD: V.conj { double-blas-vector double-blas-vector }
+    (prepare-dot) cblas_ddot ;
 METHOD: V.conj { float-complex-blas-vector float-complex-blas-vector }
     (prepare-dot)
     "CBLAS_C" <c-object> [ cblas_cdotc_sub ] keep (c-complex>) ;
@@ -288,7 +292,7 @@ METHOD: Viamax { double-complex-blas-vector }
 : Vamax ( x -- max )
     [ Viamax ] keep nth ; inline
 
-: Vsub ( v start length -- vsub )
+: Vsub ( v start length -- sub )
     rot [
         [
             nip [ inc>> ] [ element-type heap-size ] [ data>> ] tri

extra/math/erato/erato.factor

@@ -1,7 +1,7 @@
 ! Copyright (c) 2007 Samuel Tardieu.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: bit-arrays kernel lists.lazy math math.functions math.primes.list
-       math.ranges sequences ;
+       math.ranges sequences accessors ;
 IN: math.erato
 
 <PRIVATE
@@ -12,21 +12,21 @@ TUPLE: erato limit bits latest ;
   2/ 1- ; inline
 
 : is-prime ( n erato -- bool )
-  >r ind r> erato-bits nth ; inline
+  >r ind r> bits>> nth ; inline
 
 : indices ( n erato -- range )
-  erato-limit ind over 3 * ind swap rot <range> ;
+  limit>> ind over 3 * ind swap rot <range> ;
 
 : mark-multiples ( n erato -- )
-  over sq over erato-limit <=
+  over sq over limit>> <=
-  [ [ indices ] keep erato-bits [ f -rot set-nth ] curry each ] [ 2drop ] if ;
+  [ [ indices ] keep bits>> [ f -rot set-nth ] curry each ] [ 2drop ] if ;
 
 : <erato> ( n -- erato )
   dup ind 1+ <bit-array> 1 over set-bits erato boa ;
 
 : next-prime ( erato -- prime/f )
-  [ erato-latest 2 + ] keep [ set-erato-latest ] 2keep
+  [ 2 + ] change-latest [ latest>> ] keep
-  2dup erato-limit <=
+  2dup limit>> <=
   [
     2dup is-prime [ dupd mark-multiples ] [ nip next-prime ] if
   ] [

extra/odbc/odbc.factor

@@ -213,7 +213,7 @@ C: <column> column
   ] if ;
 
 : dereference-type-pointer ( byte-array column -- object )
-  column-type {
+  type>> {
     { SQL-CHAR [ ascii alien>string ] }
     { SQL-VARCHAR [ ascii alien>string ] }
     { SQL-LONGVARCHAR [ ascii alien>string ] }
@@ -235,7 +235,7 @@ TUPLE: field value column ;
 C: <field> field
 
 : odbc-get-field ( statement column -- field )
-  dup column? [ dupd odbc-describe-column ] unless dup >r column-number
+  dup column? [ dupd odbc-describe-column ] unless dup >r number>>
   SQL-C-DEFAULT
   8192 CHAR: \space <string> ascii string>alien dup >r
   8192
@@ -244,15 +244,15 @@ C: <field> field
   ] [
     r> drop r> [
       "SQLGetData Failed for Column: " %
-      dup column-name %
+      dup name>> %
-      " of type: " % dup column-type name>> %
+      " of type: " % dup type>> name>> %
     ] "" make swap <field>
   ] if ;
 
 : odbc-get-row-fields ( statement -- seq )
   [
     dup odbc-number-of-columns [
-      1+ odbc-get-field field-value ,
+      1+ odbc-get-field value>> ,
     ] with each
   ] { } make ;