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

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

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