diff --git a/basis/calendar/calendar-docs.factor b/basis/calendar/calendar-docs.factor index 19427b7c79..2c23ae95c1 100644 --- a/basis/calendar/calendar-docs.factor +++ b/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: 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< 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 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 3 days time+ day>> ." + "4" + } +} ; + diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index 402542de3b..d9284573c4 100755 --- a/basis/calendar/calendar.factor +++ b/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 ; -: years ( n -- dt ) instant clone swap >>year ; -: months ( n -- dt ) instant clone swap >>month ; -: days ( n -- dt ) instant clone swap >>day ; -: weeks ( n -- dt ) 7 * days ; -: hours ( n -- dt ) instant clone swap >>hour ; -: minutes ( n -- dt ) instant clone swap >>minute ; -: seconds ( n -- dt ) instant clone swap >>second ; -: milliseconds ( n -- dt ) 1000 / seconds ; +MEMO: instant ( -- duration ) 0 0 0 0 0 0 ; +: years ( x -- duration ) instant clone swap >>year ; +: months ( x -- duration ) instant clone swap >>month ; +: days ( x -- duration ) instant clone swap >>day ; +: weeks ( x -- duration ) 7 * days ; +: hours ( x -- duration ) instant clone swap >>hour ; +: minutes ( x -- duration ) instant clone swap >>minute ; +: seconds ( x -- duration ) instant clone swap >>second ; +: 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 ] if ; -: dt>years ( dt -- x ) - #! Uses average month/year length since dt loses calendar +: dt>years ( duration -- x ) + #! 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>days ( dt -- x ) dt>years days-per-year * ; -: dt>hours ( dt -- x ) dt>years hours-per-year * ; -: dt>minutes ( dt -- x ) dt>years minutes-per-year * ; -: dt>seconds ( dt -- x ) dt>years seconds-per-year * ; -: dt>milliseconds ( dt -- x ) dt>seconds 1000 * ; +: dt>months ( duration -- x ) dt>years months-per-year * ; +: dt>days ( duration -- x ) dt>years days-per-year * ; +: dt>hours ( duration -- x ) dt>years hours-per-year * ; +: dt>minutes ( duration -- x ) dt>years minutes-per-year * ; +: dt>seconds ( duration -- x ) dt>years seconds-per-year * ; +: dt>milliseconds ( duration -- x ) dt>seconds 1000 * ; GENERIC: time- ( time1 time2 -- time ) @@ -296,7 +296,7 @@ M: timestamp time- } 2cleave ] 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+ ; -: ago ( dt -- timestamp ) now swap time- ; +: hence ( duration -- 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 ) - clone - 0 >>hour - 0 >>minute - 0 >>second ; inline +: midnight ( timestamp -- new-timestamp ) + clone 0 >>hour 0 >>minute 0 >>second ; inline + +: noon ( timestamp -- new-timestamp ) + 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 ; diff --git a/basis/compiler/tree/propagation/info/info.factor b/basis/compiler/tree/propagation/info/info.factor index f3ecd7ae65..2281c140a4 100644 --- a/basis/compiler/tree/propagation/info/info.factor +++ b/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 ) - dup word? [ dup +interval+ word-prop ] [ f ] if [-inf,inf] or + dup word? [ dup "interval" word-prop ] [ f ] if [-inf,inf] or ; foldable : ( interval -- info ) diff --git a/basis/compiler/tree/propagation/inlining/inlining.factor b/basis/compiler/tree/propagation/inlining/inlining.factor index 09f50b21ea..4f93769b7f 100644 --- a/basis/compiler/tree/propagation/inlining/inlining.factor +++ b/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 -classes.union sets quotations assocs combinators words -namespaces +math.partial-dispatch generic generic.standard generic.math +classes.algebra classes.union sets quotations assocs combinators +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 ; diff --git a/basis/compiler/tree/propagation/known-words/known-words.factor b/basis/compiler/tree/propagation/known-words/known-words.factor index 23323e107d..c07c5a5cb5 100644 --- a/basis/compiler/tree/propagation/known-words/known-words.factor +++ b/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 @ - ] +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 - ] +outputs+ set-word-prop + ] "outputs" set-word-prop ] assoc-each { @@ -250,36 +250,36 @@ generic-comparison-ops [ } } cond [ fixnum fits? fixnum integer ? ] keep - [ 2nip ] curry +outputs+ set-word-prop + [ 2nip ] curry "outputs" set-word-prop ] each { } [ [ literal>> dup tuple-layout? [ class>> ] [ drop tuple ] if [ clear ] dip - ] +outputs+ set-word-prop + ] "outputs" set-word-prop ] each \ new [ literal>> dup tuple-class? [ drop tuple ] unless -] +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 diff --git a/basis/compiler/tree/propagation/nodes/nodes.factor b/basis/compiler/tree/propagation/nodes/nodes.factor index 358944d1b7..9e4d99e462 100644 --- a/basis/compiler/tree/propagation/nodes/nodes.factor +++ b/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 -- ) diff --git a/basis/compiler/tree/propagation/simple/simple.factor b/basis/compiler/tree/propagation/simple/simple.factor index d664ae5ccf..809a85a51f 100644 --- a/basis/compiler/tree/propagation/simple/simple.factor +++ b/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 -generic.standard generic.math +math math.private slots generic definitions 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 [ ] 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 ] } @@ -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 ] [ - [ [ output-value-infos ] [ drop out-d>> ] 2bi set-value-infos ] - [ compute-constraints ] - 2bi - ] if ; + dup word>> { + { [ 2dup foldable-call? ] [ fold-call ] } + { [ 2dup do-inlining ] [ 2drop ] } + [ + [ [ 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) ; diff --git a/basis/help/markup/markup.factor b/basis/help/markup/markup.factor index e3cefb7992..d65eb8fc88 100755 --- a/basis/help/markup/markup.factor +++ b/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 -- ) [ diff --git a/basis/help/topics/topics-tests.factor b/basis/help/topics/topics-tests.factor index c52d5e347f..699b2d398a 100644 --- a/basis/help/topics/topics-tests.factor +++ b/basis/help/topics/topics-tests.factor @@ -1,6 +1,6 @@ -USING: definitions help help.topics help.crossref help.markup -help.syntax kernel sequences tools.test words parser namespaces -assocs source-files eval ; +USING: accessors definitions help help.topics help.crossref +help.markup help.syntax kernel sequences tools.test words parser +namespaces assocs source-files eval ; IN: help.topics.tests \ article-name must-infer diff --git a/basis/macros/expander/expander.factor b/basis/macros/expander/expander.factor index f538412937..0a1703de58 100644 --- a/basis/macros/expander/expander.factor +++ b/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 [ - swap [ stack-effect in>> length ] [ +transform-n+ word-prop ] bi or + dup [ "macro" word-prop ] [ "transform-quot" word-prop ] bi or dup [ + swap [ stack-effect in>> length ] [ "transform-n" word-prop ] bi or stack get length <= ] [ 2drop f f ] if ; diff --git a/extra/math/points/points.factor b/basis/math/points/points.factor similarity index 100% rename from extra/math/points/points.factor rename to basis/math/points/points.factor diff --git a/basis/models/compose/compose-docs.factor b/basis/models/compose/compose-docs.factor index 8c07b2f09e..0f88499618 100755 --- a/basis/models/compose/compose-docs.factor +++ b/basis/models/compose/compose-docs.factor @@ -20,7 +20,7 @@ $nl HELP: { $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" diff --git a/basis/stack-checker/known-words/known-words.factor b/basis/stack-checker/known-words/known-words.factor index c01236fba9..5cbd5f40af 100755 --- a/basis/stack-checker/known-words/known-words.factor +++ b/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 +transform-quot+ word-prop ] [ apply-transform ] } + { [ dup "primitive" word-prop ] [ infer-primitive ] } + { [ 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 diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor index 200b5d9c43..1bdfdb6f42 100755 --- a/basis/stack-checker/transforms/transforms.factor +++ b/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-n+ word-prop ] + [ "transform-quot" 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 ] - [ nip +transform-n+ set-word-prop ] + [ drop "transform-quot" set-word-prop ] + [ nip "transform-n" set-word-prop ] 3bi ; ! Combinators diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index eaa0342c25..5e888cd871 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/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" - "cannot-infer" + "methods" "no-compile" "optimizer-hooks" - "output-classes" + "outputs" "participants" "predicate" "predicate-definition" "predicating" - "tuple-dispatch-generic" - "slots" + "reader" + "reading" + "recursive" + "shuffle" "slot-names" + "slots" + "special" "specializer" "step-into" "step-into?" "superclass" - "reading" - "writing" + "transform-n" + "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 diff --git a/basis/tools/deploy/test/1/deploy.factor b/basis/tools/deploy/test/1/deploy.factor index 490c21a067..098e99719e 100755 --- a/basis/tools/deploy/test/1/deploy.factor +++ b/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-ui? f } + { deploy-random? 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 } } diff --git a/basis/tools/deploy/test/2/deploy.factor b/basis/tools/deploy/test/2/deploy.factor index aeec8e94f7..c6f46eede6 100755 --- a/basis/tools/deploy/test/2/deploy.factor +++ b/basis/tools/deploy/test/2/deploy.factor @@ -1,15 +1,15 @@ USING: tools.deploy.config ; H{ - { deploy-math? t } - { deploy-compiler? t } - { deploy-reflection 2 } + { deploy-io 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 } } diff --git a/basis/tools/deploy/test/3/deploy.factor b/basis/tools/deploy/test/3/deploy.factor index dde8291658..5f45b87e0d 100755 --- a/basis/tools/deploy/test/3/deploy.factor +++ b/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 } } diff --git a/basis/tools/deploy/test/4/deploy.factor b/basis/tools/deploy/test/4/deploy.factor index 65ead56e2b..ea899e64c0 100644 --- a/basis/tools/deploy/test/4/deploy.factor +++ b/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 } } diff --git a/basis/tools/deploy/test/5/deploy.factor b/basis/tools/deploy/test/5/deploy.factor index bb4580b7ae..797116e09b 100644 --- a/basis/tools/deploy/test/5/deploy.factor +++ b/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 } } diff --git a/basis/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor index 7bda548a26..d2dfe56ed4 100755 --- a/basis/ui/freetype/freetype.factor +++ b/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 ) diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor index 06a8b4886a..8142297318 100755 --- a/basis/ui/gadgets/editors/editors.factor +++ b/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 ; diff --git a/basis/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor index bcf908571c..15850ae357 100755 --- a/basis/ui/gadgets/gadgets.factor +++ b/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 ; diff --git a/basis/ui/gadgets/handler/handler.factor b/basis/ui/gadgets/handler/handler.factor index 1ad5063013..1c12142593 100644 --- a/basis/ui/gadgets/handler/handler.factor +++ b/basis/ui/gadgets/handler/handler.factor @@ -8,4 +8,4 @@ TUPLE: handler < wrapper table ; : ( child -- handler ) handler new-wrapper ; M: handler handle-gesture ( gesture gadget -- ? ) - over table>> at dup [ call f ] [ 2drop t ] if ; \ No newline at end of file + tuck table>> at dup [ call f ] [ 2drop t ] if ; \ No newline at end of file diff --git a/basis/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor index 77b88959c9..3291a1c42a 100755 --- a/basis/ui/gadgets/incremental/incremental.factor +++ b/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 diff --git a/basis/ui/render/render.factor b/basis/ui/render/render.factor index c7bfc99024..a4bb353d1b 100644 --- a/basis/ui/render/render.factor +++ b/basis/ui/render/render.factor @@ -138,7 +138,7 @@ M: polygon draw-interior : ( color points -- gadget ) dup max-dim - >r r> over set-rect-dim + >r r> >>dim [ (>>interior) ] keep ; ! Font rendering diff --git a/basis/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor index 8f180714c8..33523701aa 100755 --- a/basis/ui/tools/browser/browser.factor +++ b/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 ; diff --git a/basis/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor index 203406c6cb..5a3ad01d2e 100644 --- a/basis/ui/tools/debugger/debugger.factor +++ b/basis/ui/tools/debugger/debugger.factor @@ -11,7 +11,7 @@ USING: accessors arrays ui ui.commands ui.gestures ui.gadgets IN: ui.tools.debugger : ( restarts restart-hook -- gadget ) - [ restart-name ] rot ; + [ name>> ] rot ; TUPLE: debugger < track restarts ; diff --git a/basis/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor index 407484ba97..89f238b574 100755 --- a/basis/ui/tools/search/search.factor +++ b/basis/ui/tools/search/search.factor @@ -118,7 +118,7 @@ M: live-search pref-dim* drop { 400 200 } ; : ( string files -- gadget ) source-file-candidates - f [ pathname-string ] ; + f [ string>> ] ; : all-source-files ( -- seq ) source-files get keys natural-sort ; @@ -146,7 +146,7 @@ M: live-search pref-dim* drop { 400 200 } ; : ( string seq -- gadget ) history-candidates - f [ input-string ] ; + f [ string>> ] ; : listener-history ( listener -- seq ) listener-gadget-input interactor-history ; diff --git a/basis/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor index 05cb043e49..92c5e09a88 100755 --- a/basis/ui/tools/traceback/traceback.factor +++ b/basis/ui/tools/traceback/traceback.factor @@ -9,15 +9,15 @@ USING: accessors continuations kernel models namespaces IN: ui.tools.traceback : ( model -- gadget ) - [ [ continuation-call callstack. ] when* ] + [ [ call>> callstack. ] when* ] t "Call stack" ; : ( model -- gadget ) - [ [ continuation-data stack. ] when* ] + [ [ data>> stack. ] when* ] t "Data stack" ; : ( model -- gadget ) - [ [ continuation-retain stack. ] when* ] + [ [ retain>> stack. ] when* ] t "Retain stack" ; TUPLE: traceback-gadget < track ; @@ -39,7 +39,7 @@ M: traceback-gadget pref-dim* drop { 550 600 } ; dup f track-add ; : ( model -- gadget ) - [ [ continuation-name namestack. ] when* ] + [ [ name>> namestack. ] when* ] ; : ( model -- gadget ) diff --git a/basis/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor index c667e6918d..767be92687 100755 --- a/basis/ui/tools/walker/walker.factor +++ b/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 -- ) - [ ] [ thread-name ] bi open-status-window ; + [ ] [ name>> ] bi open-status-window ; [ dup find-walker-window dup