diff --git a/basis/alien/c-types/c-types-tests.factor b/basis/alien/c-types/c-types-tests.factor index 276dd581c5..edda9e7fdb 100755 --- a/basis/alien/c-types/c-types-tests.factor +++ b/basis/alien/c-types/c-types-tests.factor @@ -2,6 +2,12 @@ IN: alien.c-types.tests USING: alien alien.syntax alien.c-types kernel tools.test sequences system libc alien.strings io.encodings.utf8 ; +\ expand-constants must-infer + +: xyz 123 ; + +[ { "blah" 123 } ] [ { "blah" xyz } expand-constants ] unit-test + : foo ( -- n ) "fdafd" f dlsym [ 123 ] unless* ; [ 123 ] [ foo ] unit-test diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor index c553ca5cfb..a9b39f80ab 100755 --- a/basis/alien/c-types/c-types.factor +++ b/basis/alien/c-types/c-types.factor @@ -4,7 +4,7 @@ USING: byte-arrays arrays assocs kernel kernel.private libc math namespaces parser sequences strings words assocs splitting math.parser cpu.architecture alien alien.accessors quotations layouts system compiler.units io.files io.encodings.binary -accessors combinators effects ; +accessors combinators effects continuations ; IN: alien.c-types DEFER: @@ -239,15 +239,20 @@ M: long-long-type box-return ( type -- ) } 2cleave ; : expand-constants ( c-type -- c-type' ) - #! We use def>> call instead of execute to get around - #! staging violations dup array? [ - unclip >r [ dup word? [ def>> call ] when ] map r> prefix + unclip >r [ + dup word? [ + def>> { } swap with-datastack first + ] when + ] map r> prefix ] when ; : malloc-file-contents ( path -- alien len ) binary file-contents dup malloc-byte-array swap length ; +: if-void ( type true false -- ) + pick "void" = [ drop nip call ] [ nip call ] if ; inline + [ [ alien-cell ] >>getter diff --git a/extra/colors/authors.txt b/basis/colors/authors.txt similarity index 100% rename from extra/colors/authors.txt rename to basis/colors/authors.txt diff --git a/extra/colors/colors.factor b/basis/colors/colors.factor similarity index 100% rename from extra/colors/colors.factor rename to basis/colors/colors.factor diff --git a/extra/colors/hsv/authors.txt b/basis/colors/hsv/authors.txt similarity index 100% rename from extra/colors/hsv/authors.txt rename to basis/colors/hsv/authors.txt diff --git a/extra/colors/hsv/hsv.factor b/basis/colors/hsv/hsv.factor similarity index 100% rename from extra/colors/hsv/hsv.factor rename to basis/colors/hsv/hsv.factor diff --git a/basis/disjoint-sets/disjoint-sets.factor b/basis/disjoint-sets/disjoint-sets.factor index a885e333c5..77e4a53f7b 100644 --- a/basis/disjoint-sets/disjoint-sets.factor +++ b/basis/disjoint-sets/disjoint-sets.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2008 Eric Mertens. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays hints kernel locals math hashtables -assocs fry ; - +assocs fry sequences ; IN: disjoint-sets TUPLE: disjoint-set @@ -65,6 +64,12 @@ M: disjoint-set add-atom [ 1 -rot counts>> set-at ] 2tri ; +: add-atoms ( seq disjoint-set -- ) '[ , add-atom ] each ; + +GENERIC: disjoint-set-member? ( a disjoint-set -- ? ) + +M: disjoint-set disjoint-set-member? parents>> key? ; + GENERIC: equiv-set-size ( a disjoint-set -- n ) M: disjoint-set equiv-set-size [ representative ] keep count ; @@ -83,6 +88,14 @@ M:: disjoint-set equate ( a b disjoint-set -- ) disjoint-set link-sets ] if ; +: equate-all-with ( seq a disjoint-set -- ) + '[ , , equate ] each ; + +: equate-all ( seq disjoint-set -- ) + over dup empty? [ 2drop ] [ + [ unclip-slice ] dip equate-all-with + ] if ; + M: disjoint-set clone [ parents>> ] [ ranks>> ] [ counts>> ] tri [ clone ] tri@ disjoint-set boa ; diff --git a/basis/math/constants/constants.factor b/basis/math/constants/constants.factor index c207eaa63c..118a8e8197 100755 --- a/basis/math/constants/constants.factor +++ b/basis/math/constants/constants.factor @@ -1,5 +1,6 @@ -! Copyright (C) 2004, 2005 Slava Pestov. +! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USE: math IN: math.constants : e ( -- e ) 2.7182818284590452354 ; inline @@ -7,3 +8,5 @@ IN: math.constants : phi ( -- phi ) 1.61803398874989484820 ; inline : pi ( -- pi ) 3.14159265358979323846 ; inline : epsilon ( -- epsilon ) 2.2204460492503131e-16 ; inline +: smallest-float ( -- x ) HEX: 1 bits>double ; foldable +: largest-float ( -- x ) HEX: 7fefffffffffffff bits>double ; foldable diff --git a/basis/math/ranges/ranges-docs.factor b/basis/math/ranges/ranges-docs.factor index 714fc67c9f..f3c65e51a4 100644 --- a/basis/math/ranges/ranges-docs.factor +++ b/basis/math/ranges/ranges-docs.factor @@ -1,21 +1,27 @@ -USING: help.syntax help.markup ; +USING: help.syntax help.markup arrays sequences ; IN: math.ranges ARTICLE: "ranges" "Ranges" - - "A " { $emphasis "range" } " is a virtual sequence with real elements " - "ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } "." - - $nl - - "Creating ranges:" - - { $subsection } - { $subsection [a,b] } - { $subsection (a,b] } - { $subsection [a,b) } - { $subsection (a,b) } - { $subsection [0,b] } - { $subsection [1,b] } - { $subsection [0,b) } ; \ No newline at end of file +"A " { $emphasis "range" } " is a virtual sequence with real number elements " +"ranging from " { $emphasis "a" } " to " { $emphasis "b" } " by " { $emphasis "step" } "." +$nl +"The class of ranges:" +{ $subsection range } +"Creating ranges with integer end-points. The standard mathematical convention is used, where " { $snippet "(" } " or " { $snippet ")" } " denotes that the end-point itself " { $emphasis "is not" } " part of the range; " { $snippet "[" } " or " { $snippet "]" } " denotes that the end-point " { $emphasis "is" } " part of the range:" +{ $subsection [a,b] } +{ $subsection (a,b] } +{ $subsection [a,b) } +{ $subsection (a,b) } +{ $subsection [0,b] } +{ $subsection [1,b] } +{ $subsection [0,b) } +"Creating general ranges:" +{ $subsection } +"Ranges are most frequently used with sequence combinators as a means of iterating over integers. For example," +{ $code + "3 10 [a,b] [ sqrt ] map" +} +"A range can be converted into a concrete sequence using a word such as " { $link >array } ". In most cases this is unnecessary since ranges implement the sequence protocol already. It is necessary if a mutable sequence is needed, for use with words such as " { $link set-nth } " or " { $link change-each } "." ; + +ABOUT: "ranges" \ No newline at end of file diff --git a/basis/persistent/deques/authors.txt b/basis/persistent/deques/authors.txt new file mode 100644 index 0000000000..f990dd0ed2 --- /dev/null +++ b/basis/persistent/deques/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/basis/persistent/deques/deques-docs.factor b/basis/persistent/deques/deques-docs.factor new file mode 100644 index 0000000000..56ee46a6a9 --- /dev/null +++ b/basis/persistent/deques/deques-docs.factor @@ -0,0 +1,56 @@ +USING: help.markup help.syntax kernel sequences ; +IN: persistent.deques + +ARTICLE: "persistent.deques" "Persistent deques" +"A deque is a data structure that can be used as both a queue and a stack. That is, there are two ends, the left and the right, and values can be pushed onto and popped off of both ends. These operations take O(1) amortized time and space in a normal usage pattern." +$nl +"This vocabulary provides a deque implementation which is persistent and purely functional: old versions of deques are not modified by operations. Instead, each push and pop operation creates a new deque based off the old one." +$nl +"The class of persistent deques:" +{ $subsection deque } +"To create a deque:" +{ $subsection } +{ $subsection sequence>deque } +"To test if a deque is empty:" +{ $subsection deque-empty? } +"To manipulate deques:" +{ $subsection push-left } +{ $subsection push-right } +{ $subsection pop-left } +{ $subsection pop-right } +{ $subsection deque>sequence } ; + +HELP: deque +{ $class-description "This is the class of persistent (functional) double-ended queues. All deque operations can be done in O(1) amortized time for single-threaded access while maintaining the old version. For more information, see " { $link "persistent.deques" } "." } ; + +HELP: +{ $values { "deque" "an empty deque" } } +{ $description "Creates an empty deque." } ; + +HELP: sequence>deque +{ $values { "sequence" sequence } { "deque" deque } } +{ $description "Given a sequence, creates a deque containing those elements in the order such that the beginning of the sequence is on the left and the end is on the right." } ; + +HELP: deque>sequence +{ $values { "deque" deque } { "sequence" sequence } } +{ $description "Given a deque, creates a sequence containing those elements, such that the left side of the deque is the beginning of the sequence." } ; + +HELP: deque-empty? +{ $values { "deque" deque } { "?" "t/f" } } +{ $description "Returns true if the deque is empty. This takes constant time." } ; + +HELP: push-left +{ $values { "deque" deque } { "item" object } { "newdeque" deque } } +{ $description "Creates a new deque with the given object pushed onto the left side. This takes constant time." } ; + +HELP: push-right +{ $values { "deque" deque } { "item" object } { "newdeque" deque } } +{ $description "Creates a new deque with the given object pushed onto the right side. This takes constant time." } ; + +HELP: pop-left +{ $values { "deque" object } { "item" object } { "newdeque" deque } } +{ $description "Creates a new deque with the leftmost item removed. This takes amortized constant time with single-threaded access." } ; + +HELP: pop-right +{ $values { "deque" object } { "item" object } { "newdeque" deque } } +{ $description "Creates a new deque with the rightmost item removed. This takes amortized constant time with single-threaded access." } ; diff --git a/basis/persistent/deques/deques-tests.factor b/basis/persistent/deques/deques-tests.factor new file mode 100644 index 0000000000..353828cb14 --- /dev/null +++ b/basis/persistent/deques/deques-tests.factor @@ -0,0 +1,35 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test persistent.deques kernel math ; +IN: persistent.deques.tests + +[ 3 2 1 t ] +[ { 1 2 3 } sequence>deque 3 [ pop-right ] times deque-empty? ] unit-test + +[ 1 2 3 t ] +[ { 1 2 3 } sequence>deque 3 [ pop-left ] times deque-empty? ] unit-test + +[ 1 3 2 t ] +[ { 1 2 3 } sequence>deque pop-left 2 [ pop-right ] times deque-empty? ] +unit-test + +[ { 2 3 4 5 6 1 } ] +[ { 1 2 3 4 5 6 } sequence>deque pop-left swap push-right deque>sequence ] +unit-test + +[ 1 t ] [ 1 push-left pop-right deque-empty? ] unit-test +[ 1 t ] [ 1 push-left pop-left deque-empty? ] unit-test +[ 1 t ] [ 1 push-right pop-left deque-empty? ] unit-test +[ 1 t ] [ 1 push-right pop-right deque-empty? ] unit-test + +[ 1 f ] +[ 1 push-left 2 push-left pop-right deque-empty? ] unit-test + +[ 1 f ] +[ 1 push-right 2 push-right pop-left deque-empty? ] unit-test + +[ 2 f ] +[ 1 push-right 2 push-right pop-right deque-empty? ] unit-test + +[ 2 f ] +[ 1 push-left 2 push-left pop-left deque-empty? ] unit-test diff --git a/basis/persistent/deques/deques.factor b/basis/persistent/deques/deques.factor new file mode 100644 index 0000000000..b30153aada --- /dev/null +++ b/basis/persistent/deques/deques.factor @@ -0,0 +1,76 @@ +! Copyright (C) 2008 Daniel Ehrenberg +! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors math qualified ; +QUALIFIED: sequences +IN: persistent.deques + +! Amortized O(1) push/pop on both ends for single-threaded access +! In a pathological case, if there are m modified versions from the +! same source, it could take O(m) amortized time per update. + + cons + +: each ( list quot -- ) + over + [ [ >r car>> r> call ] [ >r cdr>> r> ] 2bi each ] + [ 2drop ] if ; inline + +: reduce ( list start quot -- end ) + swapd each ; inline + +: reverse ( list -- reversed ) + f [ swap ] reduce ; + +: length ( list -- length ) + 0 [ drop 1+ ] reduce ; + +: cut ( list index -- back front-reversed ) + f swap [ >r [ cdr>> ] [ car>> ] bi r> ] times ; + +: split-reverse ( list -- back-reversed front ) + dup length 2/ cut [ reverse ] bi@ ; +PRIVATE> + +TUPLE: deque { lhs read-only } { rhs read-only } ; +: ( -- deque ) T{ deque } ; + +: deque-empty? ( deque -- ? ) + [ lhs>> ] [ rhs>> ] bi or not ; + +: push-left ( deque item -- newdeque ) + swap [ lhs>> ] [ rhs>> ] bi deque boa ; + +: push-right ( deque item -- newdeque ) + swap [ rhs>> ] [ lhs>> ] bi swap deque boa ; + +> car>> ] [ [ lhs>> cdr>> ] [ rhs>> ] bi deque boa ] bi ; + +: transfer-left ( deque -- item newdeque ) + rhs>> [ split-reverse deque boa (pop-left) ] + [ "Popping from an empty deque" throw ] if* ; +PRIVATE> + +: pop-left ( deque -- item newdeque ) + dup lhs>> [ (pop-left) ] [ transfer-left ] if ; + +> car>> ] [ [ lhs>> ] [ rhs>> cdr>> ] bi deque boa ] bi ; + +: transfer-right ( deque -- newdeque item ) + lhs>> [ split-reverse deque boa (pop-left) ] + [ "Popping from an empty deque" throw ] if* ; +PRIVATE> + +: pop-right ( deque -- item newdeque ) + dup rhs>> [ (pop-right) ] [ transfer-right ] if ; + +: sequence>deque ( sequence -- deque ) + [ push-right ] sequences:reduce ; + +: deque>sequence ( deque -- sequence ) + [ dup deque-empty? not ] [ pop-left swap ] [ ] sequences:produce nip ; diff --git a/basis/persistent/deques/summary.txt b/basis/persistent/deques/summary.txt new file mode 100644 index 0000000000..021a1e3fef --- /dev/null +++ b/basis/persistent/deques/summary.txt @@ -0,0 +1 @@ +Persistent amortized O(1) deques diff --git a/basis/persistent/deques/tags.txt b/basis/persistent/deques/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/basis/persistent/deques/tags.txt @@ -0,0 +1 @@ +collections diff --git a/basis/persistent/hashtables/hashtables-tests.factor b/basis/persistent/hashtables/hashtables-tests.factor index accebfd778..ac6aa240cc 100644 --- a/basis/persistent/hashtables/hashtables-tests.factor +++ b/basis/persistent/hashtables/hashtables-tests.factor @@ -10,6 +10,10 @@ tools.test kernel namespaces random math.ranges sequences fry ; [ f ] [ "X" PH{ { "A" "B" } } at ] unit-test +! We have to define these first so that they're compiled before +! the below hashtables are parsed... +<< + TUPLE: hash-0-a ; M: hash-0-a hashcode* 2drop 0 ; @@ -18,6 +22,8 @@ TUPLE: hash-0-b ; M: hash-0-b hashcode* 2drop 0 ; +>> + [ ] [ PH{ } "a" T{ hash-0-a } rot new-at diff --git a/basis/persistent/hashtables/hashtables.factor b/basis/persistent/hashtables/hashtables.factor index a68fa7c365..ae60aba50e 100644 --- a/basis/persistent/hashtables/hashtables.factor +++ b/basis/persistent/hashtables/hashtables.factor @@ -41,6 +41,13 @@ M: persistent-hash >alist [ root>> >alist% ] { } make ; : >persistent-hash ( assoc -- phash ) T{ persistent-hash } swap [ spin new-at ] assoc-each ; +M: persistent-hash equal? + over persistent-hash? [ assoc= ] [ 2drop f ] if ; + +M: persistent-hash hashcode* nip assoc-size ; + +M: persistent-hash clone ; + : PH{ \ } [ >persistent-hash ] parse-literal ; parsing M: persistent-hash pprint-delims drop \ PH{ \ } ; diff --git a/basis/persistent/sequences/sequences-docs.factor b/basis/persistent/sequences/sequences-docs.factor index beacf58966..986b16c737 100644 --- a/basis/persistent/sequences/sequences-docs.factor +++ b/basis/persistent/sequences/sequences-docs.factor @@ -3,15 +3,21 @@ USING: help.markup help.syntax math sequences kernel ; HELP: new-nth { $values { "val" object } { "i" integer } { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." } -{ $notes "This operation runs in " { $snippet "O(log_32 n)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; +{ $contract "Persistent analogue of " { $link set-nth } ". Outputs a new sequence with the " { $snippet "i" } "th element replaced by " { $snippet "val" } "." } ; HELP: ppush { $values { "val" object } { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." } -{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; +{ $contract "Persistent analogue of " { $link push } ". Outputs a new sequence with all elements of " { $snippet "seq" } " together with " { $snippet "val" } " added at the end." } ; HELP: ppop { $values { "seq" sequence } { "seq'" sequence } } -{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } -{ $notes "This operation runs in amortized " { $snippet "O(1)" } " time on " { $link "persistent.vectors" } " and " { $snippet "O(n)" } " time on all other sequences." } ; +{ $contract "Persistent analogue of " { $link pop* } ". Outputs a new sequence with all elements of " { $snippet "seq" } " except for the final element." } ; + +ARTICLE: "persistent.sequences" "Persistent sequence protocol" +"The persistent sequence protocol consists of the non-mutating sequence protocol words, such as " { $link length } " and " { $link nth } ", together with the following operations:" +{ $subsection new-nth } +{ $subsection ppush } +{ $subsection ppop } +"The default implementations of the above run in " { $snippet "O(n)" } " time; the " { $vocab-link "persistent.vectors" } " vocabulary provides an implementation of these operations in " { $snippet "O(1)" } " time." ; + +ABOUT: "persistent.sequences" diff --git a/basis/persistent/vectors/vectors-docs.factor b/basis/persistent/vectors/vectors-docs.factor index f17fca1ded..4816877a35 100644 --- a/basis/persistent/vectors/vectors-docs.factor +++ b/basis/persistent/vectors/vectors-docs.factor @@ -1,5 +1,5 @@ USING: help.markup help.syntax kernel math sequences ; -IN: persistent-vectors +IN: persistent.vectors HELP: PV{ { $syntax "elements... }" } @@ -12,17 +12,11 @@ HELP: >persistent-vector HELP: persistent-vector { $class-description "The class of persistent vectors." } ; -ARTICLE: "persistent-vectors" "Persistent vectors" +ARTICLE: "persistent.vectors" "Persistent vectors" "A " { $emphasis "persistent vector" } " differs from an ordinary vector (" { $link "vectors" } ") in that it is immutable, and all operations yield new persistent vectors instead of modifying inputs. Unlike immutable operations on ordinary sequences, persistent vector operations are efficient and run in sub-linear time." $nl "The class of persistent vectors:" { $subsection persistent-vector } -"Persistent vectors support the immutable sequence protocol, namely as " { $link length } " and " { $link nth } ", and so can be used with most sequence words (" { $link "sequences" } ")." -$nl -"In addition to standard sequence operations, persistent vectors implement efficient operations specific to them. They run in sub-linear time on persistent vectors, and degrate to linear-time algorithms on ordinary sequences:" -{ $subsection new-nth } -{ $subsection ppush } -{ $subsection ppop } "Converting a sequence into a persistent vector:" { $subsection >persistent-vector } "Persistent vectors have a literal syntax:" @@ -31,4 +25,4 @@ $nl $nl "This implementation of persistent vectors is based on the " { $snippet "clojure.lang.PersistentVector" } " class from Rich Hickey's Clojure language for the JVM (" { $url "http://clojure.org" } ")." ; -ABOUT: "persistent-vectors" +ABOUT: "persistent.vectors" diff --git a/extra/ui/authors.txt b/basis/ui/authors.txt similarity index 100% rename from extra/ui/authors.txt rename to basis/ui/authors.txt diff --git a/extra/ui/backend/authors.txt b/basis/ui/backend/authors.txt similarity index 100% rename from extra/ui/backend/authors.txt rename to basis/ui/backend/authors.txt diff --git a/extra/ui/backend/backend.factor b/basis/ui/backend/backend.factor similarity index 100% rename from extra/ui/backend/backend.factor rename to basis/ui/backend/backend.factor diff --git a/extra/ui/backend/summary.txt b/basis/ui/backend/summary.txt similarity index 100% rename from extra/ui/backend/summary.txt rename to basis/ui/backend/summary.txt diff --git a/extra/ui/clipboards/authors.txt b/basis/ui/clipboards/authors.txt similarity index 100% rename from extra/ui/clipboards/authors.txt rename to basis/ui/clipboards/authors.txt diff --git a/extra/ui/clipboards/clipboards-docs.factor b/basis/ui/clipboards/clipboards-docs.factor similarity index 100% rename from extra/ui/clipboards/clipboards-docs.factor rename to basis/ui/clipboards/clipboards-docs.factor diff --git a/extra/ui/clipboards/clipboards.factor b/basis/ui/clipboards/clipboards.factor similarity index 100% rename from extra/ui/clipboards/clipboards.factor rename to basis/ui/clipboards/clipboards.factor diff --git a/extra/ui/clipboards/summary.txt b/basis/ui/clipboards/summary.txt similarity index 100% rename from extra/ui/clipboards/summary.txt rename to basis/ui/clipboards/summary.txt diff --git a/extra/ui/cocoa/authors.txt b/basis/ui/cocoa/authors.txt similarity index 100% rename from extra/ui/cocoa/authors.txt rename to basis/ui/cocoa/authors.txt diff --git a/extra/ui/cocoa/cocoa.factor b/basis/ui/cocoa/cocoa.factor similarity index 100% rename from extra/ui/cocoa/cocoa.factor rename to basis/ui/cocoa/cocoa.factor diff --git a/extra/ui/cocoa/summary.txt b/basis/ui/cocoa/summary.txt similarity index 100% rename from extra/ui/cocoa/summary.txt rename to basis/ui/cocoa/summary.txt diff --git a/extra/ui/cocoa/tags.txt b/basis/ui/cocoa/tags.txt similarity index 100% rename from extra/ui/cocoa/tags.txt rename to basis/ui/cocoa/tags.txt diff --git a/extra/ui/cocoa/tools/authors.txt b/basis/ui/cocoa/tools/authors.txt similarity index 100% rename from extra/ui/cocoa/tools/authors.txt rename to basis/ui/cocoa/tools/authors.txt diff --git a/extra/ui/cocoa/tools/summary.txt b/basis/ui/cocoa/tools/summary.txt similarity index 100% rename from extra/ui/cocoa/tools/summary.txt rename to basis/ui/cocoa/tools/summary.txt diff --git a/extra/ui/cocoa/tools/tags.txt b/basis/ui/cocoa/tools/tags.txt similarity index 100% rename from extra/ui/cocoa/tools/tags.txt rename to basis/ui/cocoa/tools/tags.txt diff --git a/extra/ui/cocoa/tools/tools.factor b/basis/ui/cocoa/tools/tools.factor similarity index 100% rename from extra/ui/cocoa/tools/tools.factor rename to basis/ui/cocoa/tools/tools.factor diff --git a/extra/ui/cocoa/views/authors.txt b/basis/ui/cocoa/views/authors.txt similarity index 100% rename from extra/ui/cocoa/views/authors.txt rename to basis/ui/cocoa/views/authors.txt diff --git a/extra/ui/cocoa/views/summary.txt b/basis/ui/cocoa/views/summary.txt similarity index 100% rename from extra/ui/cocoa/views/summary.txt rename to basis/ui/cocoa/views/summary.txt diff --git a/extra/ui/cocoa/views/tags.txt b/basis/ui/cocoa/views/tags.txt similarity index 100% rename from extra/ui/cocoa/views/tags.txt rename to basis/ui/cocoa/views/tags.txt diff --git a/extra/ui/cocoa/views/views.factor b/basis/ui/cocoa/views/views.factor similarity index 100% rename from extra/ui/cocoa/views/views.factor rename to basis/ui/cocoa/views/views.factor diff --git a/extra/ui/commands/authors.txt b/basis/ui/commands/authors.txt similarity index 100% rename from extra/ui/commands/authors.txt rename to basis/ui/commands/authors.txt diff --git a/extra/ui/commands/commands-docs.factor b/basis/ui/commands/commands-docs.factor similarity index 100% rename from extra/ui/commands/commands-docs.factor rename to basis/ui/commands/commands-docs.factor diff --git a/extra/ui/commands/commands-tests.factor b/basis/ui/commands/commands-tests.factor similarity index 100% rename from extra/ui/commands/commands-tests.factor rename to basis/ui/commands/commands-tests.factor diff --git a/extra/ui/commands/commands.factor b/basis/ui/commands/commands.factor similarity index 100% rename from extra/ui/commands/commands.factor rename to basis/ui/commands/commands.factor diff --git a/extra/ui/commands/summary.txt b/basis/ui/commands/summary.txt similarity index 100% rename from extra/ui/commands/summary.txt rename to basis/ui/commands/summary.txt diff --git a/extra/ui/freetype/authors.txt b/basis/ui/freetype/authors.txt similarity index 100% rename from extra/ui/freetype/authors.txt rename to basis/ui/freetype/authors.txt diff --git a/extra/ui/freetype/freetype-docs.factor b/basis/ui/freetype/freetype-docs.factor similarity index 100% rename from extra/ui/freetype/freetype-docs.factor rename to basis/ui/freetype/freetype-docs.factor diff --git a/extra/ui/freetype/freetype.factor b/basis/ui/freetype/freetype.factor similarity index 100% rename from extra/ui/freetype/freetype.factor rename to basis/ui/freetype/freetype.factor diff --git a/extra/ui/freetype/summary.txt b/basis/ui/freetype/summary.txt similarity index 100% rename from extra/ui/freetype/summary.txt rename to basis/ui/freetype/summary.txt diff --git a/extra/ui/gadgets/authors.txt b/basis/ui/gadgets/authors.txt similarity index 100% rename from extra/ui/gadgets/authors.txt rename to basis/ui/gadgets/authors.txt diff --git a/extra/ui/gadgets/books/authors.txt b/basis/ui/gadgets/books/authors.txt similarity index 100% rename from extra/ui/gadgets/books/authors.txt rename to basis/ui/gadgets/books/authors.txt diff --git a/extra/ui/gadgets/books/books-docs.factor b/basis/ui/gadgets/books/books-docs.factor similarity index 100% rename from extra/ui/gadgets/books/books-docs.factor rename to basis/ui/gadgets/books/books-docs.factor diff --git a/extra/ui/gadgets/books/books-tests.factor b/basis/ui/gadgets/books/books-tests.factor similarity index 100% rename from extra/ui/gadgets/books/books-tests.factor rename to basis/ui/gadgets/books/books-tests.factor diff --git a/extra/ui/gadgets/books/books.factor b/basis/ui/gadgets/books/books.factor similarity index 100% rename from extra/ui/gadgets/books/books.factor rename to basis/ui/gadgets/books/books.factor diff --git a/extra/ui/gadgets/books/summary.txt b/basis/ui/gadgets/books/summary.txt similarity index 100% rename from extra/ui/gadgets/books/summary.txt rename to basis/ui/gadgets/books/summary.txt diff --git a/extra/ui/gadgets/borders/authors.txt b/basis/ui/gadgets/borders/authors.txt similarity index 100% rename from extra/ui/gadgets/borders/authors.txt rename to basis/ui/gadgets/borders/authors.txt diff --git a/extra/ui/gadgets/borders/borders-docs.factor b/basis/ui/gadgets/borders/borders-docs.factor similarity index 100% rename from extra/ui/gadgets/borders/borders-docs.factor rename to basis/ui/gadgets/borders/borders-docs.factor diff --git a/extra/ui/gadgets/borders/borders-tests.factor b/basis/ui/gadgets/borders/borders-tests.factor similarity index 100% rename from extra/ui/gadgets/borders/borders-tests.factor rename to basis/ui/gadgets/borders/borders-tests.factor diff --git a/extra/ui/gadgets/borders/borders.factor b/basis/ui/gadgets/borders/borders.factor similarity index 100% rename from extra/ui/gadgets/borders/borders.factor rename to basis/ui/gadgets/borders/borders.factor diff --git a/extra/ui/gadgets/borders/summary.txt b/basis/ui/gadgets/borders/summary.txt similarity index 100% rename from extra/ui/gadgets/borders/summary.txt rename to basis/ui/gadgets/borders/summary.txt diff --git a/extra/ui/gadgets/buttons/authors.txt b/basis/ui/gadgets/buttons/authors.txt similarity index 100% rename from extra/ui/gadgets/buttons/authors.txt rename to basis/ui/gadgets/buttons/authors.txt diff --git a/extra/ui/gadgets/buttons/buttons-docs.factor b/basis/ui/gadgets/buttons/buttons-docs.factor similarity index 100% rename from extra/ui/gadgets/buttons/buttons-docs.factor rename to basis/ui/gadgets/buttons/buttons-docs.factor diff --git a/extra/ui/gadgets/buttons/buttons-tests.factor b/basis/ui/gadgets/buttons/buttons-tests.factor similarity index 100% rename from extra/ui/gadgets/buttons/buttons-tests.factor rename to basis/ui/gadgets/buttons/buttons-tests.factor diff --git a/extra/ui/gadgets/buttons/buttons.factor b/basis/ui/gadgets/buttons/buttons.factor similarity index 98% rename from extra/ui/gadgets/buttons/buttons.factor rename to basis/ui/gadgets/buttons/buttons.factor index c5a5e8bad8..d60901d993 100755 --- a/extra/ui/gadgets/buttons/buttons.factor +++ b/basis/ui/gadgets/buttons/buttons.factor @@ -199,14 +199,11 @@ M: radio-control model-changed : ( value model label -- gadget ) label-on-right radio-button-theme ; -: radio-buttons-theme ( gadget -- ) - { 5 5 } >>gap drop ; - : ( model assoc -- gadget ) -rot [ ] - dup radio-buttons-theme ; + { 5 5 } >>gap ; : ( value model label -- gadget ) bevel-button-theme ; diff --git a/extra/ui/gadgets/buttons/summary.txt b/basis/ui/gadgets/buttons/summary.txt similarity index 100% rename from extra/ui/gadgets/buttons/summary.txt rename to basis/ui/gadgets/buttons/summary.txt diff --git a/extra/ui/gadgets/canvas/authors.txt b/basis/ui/gadgets/canvas/authors.txt similarity index 100% rename from extra/ui/gadgets/canvas/authors.txt rename to basis/ui/gadgets/canvas/authors.txt diff --git a/extra/ui/gadgets/canvas/canvas.factor b/basis/ui/gadgets/canvas/canvas.factor similarity index 100% rename from extra/ui/gadgets/canvas/canvas.factor rename to basis/ui/gadgets/canvas/canvas.factor diff --git a/extra/ui/gadgets/cartesian/cartesian.factor b/basis/ui/gadgets/cartesian/cartesian.factor similarity index 100% rename from extra/ui/gadgets/cartesian/cartesian.factor rename to basis/ui/gadgets/cartesian/cartesian.factor diff --git a/extra/ui/gadgets/editors/authors.txt b/basis/ui/gadgets/editors/authors.txt similarity index 100% rename from extra/ui/gadgets/editors/authors.txt rename to basis/ui/gadgets/editors/authors.txt diff --git a/extra/ui/gadgets/editors/editors-docs.factor b/basis/ui/gadgets/editors/editors-docs.factor similarity index 100% rename from extra/ui/gadgets/editors/editors-docs.factor rename to basis/ui/gadgets/editors/editors-docs.factor diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor similarity index 100% rename from extra/ui/gadgets/editors/editors-tests.factor rename to basis/ui/gadgets/editors/editors-tests.factor diff --git a/extra/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor similarity index 100% rename from extra/ui/gadgets/editors/editors.factor rename to basis/ui/gadgets/editors/editors.factor diff --git a/extra/ui/gadgets/editors/summary.txt b/basis/ui/gadgets/editors/summary.txt similarity index 100% rename from extra/ui/gadgets/editors/summary.txt rename to basis/ui/gadgets/editors/summary.txt diff --git a/extra/ui/gadgets/frame-buffer/frame-buffer.factor b/basis/ui/gadgets/frame-buffer/frame-buffer.factor similarity index 100% rename from extra/ui/gadgets/frame-buffer/frame-buffer.factor rename to basis/ui/gadgets/frame-buffer/frame-buffer.factor diff --git a/extra/ui/gadgets/frames/authors.txt b/basis/ui/gadgets/frames/authors.txt similarity index 100% rename from extra/ui/gadgets/frames/authors.txt rename to basis/ui/gadgets/frames/authors.txt diff --git a/extra/ui/gadgets/frames/frames-docs.factor b/basis/ui/gadgets/frames/frames-docs.factor similarity index 100% rename from extra/ui/gadgets/frames/frames-docs.factor rename to basis/ui/gadgets/frames/frames-docs.factor diff --git a/extra/ui/gadgets/frames/frames-tests.factor b/basis/ui/gadgets/frames/frames-tests.factor similarity index 100% rename from extra/ui/gadgets/frames/frames-tests.factor rename to basis/ui/gadgets/frames/frames-tests.factor diff --git a/extra/ui/gadgets/frames/frames.factor b/basis/ui/gadgets/frames/frames.factor similarity index 100% rename from extra/ui/gadgets/frames/frames.factor rename to basis/ui/gadgets/frames/frames.factor diff --git a/extra/ui/gadgets/frames/summary.txt b/basis/ui/gadgets/frames/summary.txt similarity index 100% rename from extra/ui/gadgets/frames/summary.txt rename to basis/ui/gadgets/frames/summary.txt diff --git a/extra/ui/gadgets/gadgets-docs.factor b/basis/ui/gadgets/gadgets-docs.factor similarity index 100% rename from extra/ui/gadgets/gadgets-docs.factor rename to basis/ui/gadgets/gadgets-docs.factor diff --git a/extra/ui/gadgets/gadgets-tests.factor b/basis/ui/gadgets/gadgets-tests.factor similarity index 100% rename from extra/ui/gadgets/gadgets-tests.factor rename to basis/ui/gadgets/gadgets-tests.factor diff --git a/extra/ui/gadgets/gadgets.factor b/basis/ui/gadgets/gadgets.factor similarity index 100% rename from extra/ui/gadgets/gadgets.factor rename to basis/ui/gadgets/gadgets.factor diff --git a/extra/ui/gadgets/grid-lines/authors.txt b/basis/ui/gadgets/grid-lines/authors.txt similarity index 100% rename from extra/ui/gadgets/grid-lines/authors.txt rename to basis/ui/gadgets/grid-lines/authors.txt diff --git a/extra/ui/gadgets/grid-lines/grid-lines-docs.factor b/basis/ui/gadgets/grid-lines/grid-lines-docs.factor similarity index 100% rename from extra/ui/gadgets/grid-lines/grid-lines-docs.factor rename to basis/ui/gadgets/grid-lines/grid-lines-docs.factor diff --git a/extra/ui/gadgets/grid-lines/grid-lines.factor b/basis/ui/gadgets/grid-lines/grid-lines.factor similarity index 100% rename from extra/ui/gadgets/grid-lines/grid-lines.factor rename to basis/ui/gadgets/grid-lines/grid-lines.factor diff --git a/extra/ui/gadgets/grid-lines/summary.txt b/basis/ui/gadgets/grid-lines/summary.txt similarity index 100% rename from extra/ui/gadgets/grid-lines/summary.txt rename to basis/ui/gadgets/grid-lines/summary.txt diff --git a/extra/ui/gadgets/grids/authors.txt b/basis/ui/gadgets/grids/authors.txt similarity index 100% rename from extra/ui/gadgets/grids/authors.txt rename to basis/ui/gadgets/grids/authors.txt diff --git a/extra/ui/gadgets/grids/grids-docs.factor b/basis/ui/gadgets/grids/grids-docs.factor similarity index 100% rename from extra/ui/gadgets/grids/grids-docs.factor rename to basis/ui/gadgets/grids/grids-docs.factor diff --git a/extra/ui/gadgets/grids/grids-tests.factor b/basis/ui/gadgets/grids/grids-tests.factor similarity index 100% rename from extra/ui/gadgets/grids/grids-tests.factor rename to basis/ui/gadgets/grids/grids-tests.factor diff --git a/extra/ui/gadgets/grids/grids.factor b/basis/ui/gadgets/grids/grids.factor similarity index 100% rename from extra/ui/gadgets/grids/grids.factor rename to basis/ui/gadgets/grids/grids.factor diff --git a/extra/ui/gadgets/grids/summary.txt b/basis/ui/gadgets/grids/summary.txt similarity index 100% rename from extra/ui/gadgets/grids/summary.txt rename to basis/ui/gadgets/grids/summary.txt diff --git a/extra/ui/gadgets/handler/authors.txt b/basis/ui/gadgets/handler/authors.txt similarity index 100% rename from extra/ui/gadgets/handler/authors.txt rename to basis/ui/gadgets/handler/authors.txt diff --git a/extra/ui/gadgets/handler/handler.factor b/basis/ui/gadgets/handler/handler.factor similarity index 100% rename from extra/ui/gadgets/handler/handler.factor rename to basis/ui/gadgets/handler/handler.factor diff --git a/extra/ui/gadgets/incremental/authors.txt b/basis/ui/gadgets/incremental/authors.txt similarity index 100% rename from extra/ui/gadgets/incremental/authors.txt rename to basis/ui/gadgets/incremental/authors.txt diff --git a/extra/ui/gadgets/incremental/incremental-docs.factor b/basis/ui/gadgets/incremental/incremental-docs.factor similarity index 100% rename from extra/ui/gadgets/incremental/incremental-docs.factor rename to basis/ui/gadgets/incremental/incremental-docs.factor diff --git a/extra/ui/gadgets/incremental/incremental.factor b/basis/ui/gadgets/incremental/incremental.factor similarity index 100% rename from extra/ui/gadgets/incremental/incremental.factor rename to basis/ui/gadgets/incremental/incremental.factor diff --git a/extra/ui/gadgets/incremental/summary.txt b/basis/ui/gadgets/incremental/summary.txt similarity index 100% rename from extra/ui/gadgets/incremental/summary.txt rename to basis/ui/gadgets/incremental/summary.txt diff --git a/extra/ui/gadgets/labelled/authors.txt b/basis/ui/gadgets/labelled/authors.txt similarity index 100% rename from extra/ui/gadgets/labelled/authors.txt rename to basis/ui/gadgets/labelled/authors.txt diff --git a/extra/ui/gadgets/labelled/labelled-docs.factor b/basis/ui/gadgets/labelled/labelled-docs.factor similarity index 100% rename from extra/ui/gadgets/labelled/labelled-docs.factor rename to basis/ui/gadgets/labelled/labelled-docs.factor diff --git a/extra/ui/gadgets/labelled/labelled.factor b/basis/ui/gadgets/labelled/labelled.factor similarity index 100% rename from extra/ui/gadgets/labelled/labelled.factor rename to basis/ui/gadgets/labelled/labelled.factor diff --git a/extra/ui/gadgets/labelled/summary.txt b/basis/ui/gadgets/labelled/summary.txt similarity index 100% rename from extra/ui/gadgets/labelled/summary.txt rename to basis/ui/gadgets/labelled/summary.txt diff --git a/extra/ui/gadgets/labels/authors.txt b/basis/ui/gadgets/labels/authors.txt similarity index 100% rename from extra/ui/gadgets/labels/authors.txt rename to basis/ui/gadgets/labels/authors.txt diff --git a/extra/ui/gadgets/labels/labels-docs.factor b/basis/ui/gadgets/labels/labels-docs.factor similarity index 100% rename from extra/ui/gadgets/labels/labels-docs.factor rename to basis/ui/gadgets/labels/labels-docs.factor diff --git a/extra/ui/gadgets/labels/labels.factor b/basis/ui/gadgets/labels/labels.factor similarity index 100% rename from extra/ui/gadgets/labels/labels.factor rename to basis/ui/gadgets/labels/labels.factor diff --git a/extra/ui/gadgets/labels/summary.txt b/basis/ui/gadgets/labels/summary.txt similarity index 100% rename from extra/ui/gadgets/labels/summary.txt rename to basis/ui/gadgets/labels/summary.txt diff --git a/extra/ui/gadgets/lib/authors.txt b/basis/ui/gadgets/lib/authors.txt similarity index 100% rename from extra/ui/gadgets/lib/authors.txt rename to basis/ui/gadgets/lib/authors.txt diff --git a/extra/ui/gadgets/lib/lib.factor b/basis/ui/gadgets/lib/lib.factor similarity index 100% rename from extra/ui/gadgets/lib/lib.factor rename to basis/ui/gadgets/lib/lib.factor diff --git a/extra/ui/gadgets/lists/authors.txt b/basis/ui/gadgets/lists/authors.txt similarity index 100% rename from extra/ui/gadgets/lists/authors.txt rename to basis/ui/gadgets/lists/authors.txt diff --git a/extra/ui/gadgets/lists/lists-docs.factor b/basis/ui/gadgets/lists/lists-docs.factor similarity index 100% rename from extra/ui/gadgets/lists/lists-docs.factor rename to basis/ui/gadgets/lists/lists-docs.factor diff --git a/extra/ui/gadgets/lists/lists-tests.factor b/basis/ui/gadgets/lists/lists-tests.factor similarity index 100% rename from extra/ui/gadgets/lists/lists-tests.factor rename to basis/ui/gadgets/lists/lists-tests.factor diff --git a/extra/ui/gadgets/lists/lists.factor b/basis/ui/gadgets/lists/lists.factor similarity index 100% rename from extra/ui/gadgets/lists/lists.factor rename to basis/ui/gadgets/lists/lists.factor diff --git a/extra/ui/gadgets/lists/summary.txt b/basis/ui/gadgets/lists/summary.txt similarity index 100% rename from extra/ui/gadgets/lists/summary.txt rename to basis/ui/gadgets/lists/summary.txt diff --git a/extra/ui/gadgets/menus/authors.txt b/basis/ui/gadgets/menus/authors.txt similarity index 100% rename from extra/ui/gadgets/menus/authors.txt rename to basis/ui/gadgets/menus/authors.txt diff --git a/extra/ui/gadgets/menus/menus-docs.factor b/basis/ui/gadgets/menus/menus-docs.factor similarity index 100% rename from extra/ui/gadgets/menus/menus-docs.factor rename to basis/ui/gadgets/menus/menus-docs.factor diff --git a/extra/ui/gadgets/menus/menus.factor b/basis/ui/gadgets/menus/menus.factor similarity index 100% rename from extra/ui/gadgets/menus/menus.factor rename to basis/ui/gadgets/menus/menus.factor diff --git a/extra/ui/gadgets/menus/summary.txt b/basis/ui/gadgets/menus/summary.txt similarity index 100% rename from extra/ui/gadgets/menus/summary.txt rename to basis/ui/gadgets/menus/summary.txt diff --git a/extra/ui/gadgets/packs/authors.txt b/basis/ui/gadgets/packs/authors.txt similarity index 100% rename from extra/ui/gadgets/packs/authors.txt rename to basis/ui/gadgets/packs/authors.txt diff --git a/extra/ui/gadgets/packs/packs-docs.factor b/basis/ui/gadgets/packs/packs-docs.factor similarity index 100% rename from extra/ui/gadgets/packs/packs-docs.factor rename to basis/ui/gadgets/packs/packs-docs.factor diff --git a/extra/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor similarity index 100% rename from extra/ui/gadgets/packs/packs-tests.factor rename to basis/ui/gadgets/packs/packs-tests.factor diff --git a/extra/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor similarity index 100% rename from extra/ui/gadgets/packs/packs.factor rename to basis/ui/gadgets/packs/packs.factor diff --git a/extra/ui/gadgets/packs/summary.txt b/basis/ui/gadgets/packs/summary.txt similarity index 100% rename from extra/ui/gadgets/packs/summary.txt rename to basis/ui/gadgets/packs/summary.txt diff --git a/extra/ui/gadgets/panes/authors.txt b/basis/ui/gadgets/panes/authors.txt similarity index 100% rename from extra/ui/gadgets/panes/authors.txt rename to basis/ui/gadgets/panes/authors.txt diff --git a/extra/ui/gadgets/panes/panes-docs.factor b/basis/ui/gadgets/panes/panes-docs.factor similarity index 100% rename from extra/ui/gadgets/panes/panes-docs.factor rename to basis/ui/gadgets/panes/panes-docs.factor diff --git a/extra/ui/gadgets/panes/panes-tests.factor b/basis/ui/gadgets/panes/panes-tests.factor similarity index 100% rename from extra/ui/gadgets/panes/panes-tests.factor rename to basis/ui/gadgets/panes/panes-tests.factor diff --git a/extra/ui/gadgets/panes/panes.factor b/basis/ui/gadgets/panes/panes.factor similarity index 100% rename from extra/ui/gadgets/panes/panes.factor rename to basis/ui/gadgets/panes/panes.factor diff --git a/extra/ui/gadgets/panes/summary.txt b/basis/ui/gadgets/panes/summary.txt similarity index 100% rename from extra/ui/gadgets/panes/summary.txt rename to basis/ui/gadgets/panes/summary.txt diff --git a/extra/ui/gadgets/paragraphs/authors.txt b/basis/ui/gadgets/paragraphs/authors.txt similarity index 100% rename from extra/ui/gadgets/paragraphs/authors.txt rename to basis/ui/gadgets/paragraphs/authors.txt diff --git a/extra/ui/gadgets/paragraphs/paragraphs.factor b/basis/ui/gadgets/paragraphs/paragraphs.factor similarity index 100% rename from extra/ui/gadgets/paragraphs/paragraphs.factor rename to basis/ui/gadgets/paragraphs/paragraphs.factor diff --git a/extra/ui/gadgets/paragraphs/summary.txt b/basis/ui/gadgets/paragraphs/summary.txt similarity index 100% rename from extra/ui/gadgets/paragraphs/summary.txt rename to basis/ui/gadgets/paragraphs/summary.txt diff --git a/extra/ui/gadgets/plot/plot.factor b/basis/ui/gadgets/plot/plot.factor similarity index 98% rename from extra/ui/gadgets/plot/plot.factor rename to basis/ui/gadgets/plot/plot.factor index cf48c5ab9d..52cd2faed7 100644 --- a/extra/ui/gadgets/plot/plot.factor +++ b/basis/ui/gadgets/plot/plot.factor @@ -28,7 +28,7 @@ TUPLE: function function color ; GENERIC: plot-function ( plot object -- plot ) -M: quotation plot-function ( plot quotation -- plot ) +M: callable plot-function ( plot quotation -- plot ) >r dup plot-range r> '[ dup @ 2array ] map line-strip ; M: function plot-function ( plot function -- plot ) diff --git a/extra/ui/gadgets/presentations/authors.txt b/basis/ui/gadgets/presentations/authors.txt similarity index 100% rename from extra/ui/gadgets/presentations/authors.txt rename to basis/ui/gadgets/presentations/authors.txt diff --git a/extra/ui/gadgets/presentations/presentations-docs.factor b/basis/ui/gadgets/presentations/presentations-docs.factor similarity index 100% rename from extra/ui/gadgets/presentations/presentations-docs.factor rename to basis/ui/gadgets/presentations/presentations-docs.factor diff --git a/extra/ui/gadgets/presentations/presentations-tests.factor b/basis/ui/gadgets/presentations/presentations-tests.factor similarity index 100% rename from extra/ui/gadgets/presentations/presentations-tests.factor rename to basis/ui/gadgets/presentations/presentations-tests.factor diff --git a/extra/ui/gadgets/presentations/presentations.factor b/basis/ui/gadgets/presentations/presentations.factor similarity index 100% rename from extra/ui/gadgets/presentations/presentations.factor rename to basis/ui/gadgets/presentations/presentations.factor diff --git a/extra/ui/gadgets/presentations/summary.txt b/basis/ui/gadgets/presentations/summary.txt similarity index 100% rename from extra/ui/gadgets/presentations/summary.txt rename to basis/ui/gadgets/presentations/summary.txt diff --git a/extra/ui/gadgets/scrollers/authors.txt b/basis/ui/gadgets/scrollers/authors.txt similarity index 100% rename from extra/ui/gadgets/scrollers/authors.txt rename to basis/ui/gadgets/scrollers/authors.txt diff --git a/extra/ui/gadgets/scrollers/scrollers-docs.factor b/basis/ui/gadgets/scrollers/scrollers-docs.factor similarity index 100% rename from extra/ui/gadgets/scrollers/scrollers-docs.factor rename to basis/ui/gadgets/scrollers/scrollers-docs.factor diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor similarity index 100% rename from extra/ui/gadgets/scrollers/scrollers-tests.factor rename to basis/ui/gadgets/scrollers/scrollers-tests.factor diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor similarity index 100% rename from extra/ui/gadgets/scrollers/scrollers.factor rename to basis/ui/gadgets/scrollers/scrollers.factor diff --git a/extra/ui/gadgets/scrollers/summary.txt b/basis/ui/gadgets/scrollers/summary.txt similarity index 100% rename from extra/ui/gadgets/scrollers/summary.txt rename to basis/ui/gadgets/scrollers/summary.txt diff --git a/extra/ui/gadgets/slate/authors.txt b/basis/ui/gadgets/slate/authors.txt similarity index 100% rename from extra/ui/gadgets/slate/authors.txt rename to basis/ui/gadgets/slate/authors.txt diff --git a/extra/ui/gadgets/slate/slate.factor b/basis/ui/gadgets/slate/slate.factor similarity index 100% rename from extra/ui/gadgets/slate/slate.factor rename to basis/ui/gadgets/slate/slate.factor diff --git a/extra/ui/gadgets/sliders/authors.txt b/basis/ui/gadgets/sliders/authors.txt similarity index 100% rename from extra/ui/gadgets/sliders/authors.txt rename to basis/ui/gadgets/sliders/authors.txt diff --git a/extra/ui/gadgets/sliders/sliders-docs.factor b/basis/ui/gadgets/sliders/sliders-docs.factor similarity index 100% rename from extra/ui/gadgets/sliders/sliders-docs.factor rename to basis/ui/gadgets/sliders/sliders-docs.factor diff --git a/extra/ui/gadgets/sliders/sliders.factor b/basis/ui/gadgets/sliders/sliders.factor similarity index 100% rename from extra/ui/gadgets/sliders/sliders.factor rename to basis/ui/gadgets/sliders/sliders.factor diff --git a/extra/ui/gadgets/sliders/summary.txt b/basis/ui/gadgets/sliders/summary.txt similarity index 100% rename from extra/ui/gadgets/sliders/summary.txt rename to basis/ui/gadgets/sliders/summary.txt diff --git a/extra/ui/gadgets/slots/authors.txt b/basis/ui/gadgets/slots/authors.txt similarity index 100% rename from extra/ui/gadgets/slots/authors.txt rename to basis/ui/gadgets/slots/authors.txt diff --git a/extra/ui/gadgets/slots/slots-tests.factor b/basis/ui/gadgets/slots/slots-tests.factor similarity index 100% rename from extra/ui/gadgets/slots/slots-tests.factor rename to basis/ui/gadgets/slots/slots-tests.factor diff --git a/extra/ui/gadgets/slots/slots.factor b/basis/ui/gadgets/slots/slots.factor similarity index 100% rename from extra/ui/gadgets/slots/slots.factor rename to basis/ui/gadgets/slots/slots.factor diff --git a/extra/ui/gadgets/slots/summary.txt b/basis/ui/gadgets/slots/summary.txt similarity index 100% rename from extra/ui/gadgets/slots/summary.txt rename to basis/ui/gadgets/slots/summary.txt diff --git a/extra/ui/gadgets/status-bar/authors.txt b/basis/ui/gadgets/status-bar/authors.txt similarity index 100% rename from extra/ui/gadgets/status-bar/authors.txt rename to basis/ui/gadgets/status-bar/authors.txt diff --git a/extra/ui/gadgets/status-bar/status-bar-docs.factor b/basis/ui/gadgets/status-bar/status-bar-docs.factor similarity index 100% rename from extra/ui/gadgets/status-bar/status-bar-docs.factor rename to basis/ui/gadgets/status-bar/status-bar-docs.factor diff --git a/extra/ui/gadgets/status-bar/status-bar.factor b/basis/ui/gadgets/status-bar/status-bar.factor similarity index 100% rename from extra/ui/gadgets/status-bar/status-bar.factor rename to basis/ui/gadgets/status-bar/status-bar.factor diff --git a/extra/ui/gadgets/status-bar/summary.txt b/basis/ui/gadgets/status-bar/summary.txt similarity index 100% rename from extra/ui/gadgets/status-bar/summary.txt rename to basis/ui/gadgets/status-bar/summary.txt diff --git a/extra/ui/gadgets/summary.txt b/basis/ui/gadgets/summary.txt similarity index 100% rename from extra/ui/gadgets/summary.txt rename to basis/ui/gadgets/summary.txt diff --git a/extra/ui/gadgets/tabs/authors.txt b/basis/ui/gadgets/tabs/authors.txt similarity index 100% rename from extra/ui/gadgets/tabs/authors.txt rename to basis/ui/gadgets/tabs/authors.txt diff --git a/extra/ui/gadgets/tabs/summary.txt b/basis/ui/gadgets/tabs/summary.txt similarity index 100% rename from extra/ui/gadgets/tabs/summary.txt rename to basis/ui/gadgets/tabs/summary.txt diff --git a/extra/ui/gadgets/tabs/tabs.factor b/basis/ui/gadgets/tabs/tabs.factor similarity index 91% rename from extra/ui/gadgets/tabs/tabs.factor rename to basis/ui/gadgets/tabs/tabs.factor index 12031e5911..50e2df2e9e 100755 --- a/extra/ui/gadgets/tabs/tabs.factor +++ b/basis/ui/gadgets/tabs/tabs.factor @@ -48,8 +48,8 @@ DEFER: (del-page) : del-page ( name tabbed -- ) [ names>> index ] 2keep (del-page) ; -: ( assoc -- tabbed ) - tabbed new-frame +: new-tabbed ( assoc class -- tabbed ) + new-frame 0 >>model 1 >>fill >>toggler dup toggler>> @left grid-add @@ -59,3 +59,4 @@ DEFER: (del-page) bi dup redo-toggler ; +: ( assoc -- tabbed ) tabbed new-tabbed ; diff --git a/extra/ui/gadgets/theme/authors.txt b/basis/ui/gadgets/theme/authors.txt similarity index 100% rename from extra/ui/gadgets/theme/authors.txt rename to basis/ui/gadgets/theme/authors.txt diff --git a/extra/ui/gadgets/theme/summary.txt b/basis/ui/gadgets/theme/summary.txt similarity index 100% rename from extra/ui/gadgets/theme/summary.txt rename to basis/ui/gadgets/theme/summary.txt diff --git a/extra/ui/gadgets/theme/theme.factor b/basis/ui/gadgets/theme/theme.factor similarity index 54% rename from extra/ui/gadgets/theme/theme.factor rename to basis/ui/gadgets/theme/theme.factor index 20f560e309..46fa0105a3 100644 --- a/extra/ui/gadgets/theme/theme.factor +++ b/basis/ui/gadgets/theme/theme.factor @@ -18,41 +18,41 @@ IN: ui.gadgets.theme : plain-gradient T{ gradient f { - T{ rgba f 0.94 0.94 0.94 1.0 } - T{ rgba f 0.83 0.83 0.83 1.0 } - T{ rgba f 0.83 0.83 0.83 1.0 } - T{ rgba f 0.62 0.62 0.62 1.0 } + T{ gray f 0.94 1.0 } + T{ gray f 0.83 1.0 } + T{ gray f 0.83 1.0 } + T{ gray f 0.62 1.0 } } } ; : rollover-gradient T{ gradient f { - T{ rgba f 1.0 1.0 1.0 1.0 } - T{ rgba f 0.9 0.9 0.9 1.0 } - T{ rgba f 0.9 0.9 0.9 1.0 } - T{ rgba f 0.75 0.75 0.75 1.0 } + T{ gray f 1.0 1.0 } + T{ gray f 0.9 1.0 } + T{ gray f 0.9 1.0 } + T{ gray f 0.75 1.0 } } } ; : pressed-gradient T{ gradient f { - T{ rgba f 0.75 0.75 0.75 1.0 } - T{ rgba f 0.9 0.9 0.9 1.0 } - T{ rgba f 0.9 0.9 0.9 1.0 } - T{ rgba f 1.0 1.0 1.0 1.0 } + T{ gray f 0.75 1.0 } + T{ gray f 0.9 1.0 } + T{ gray f 0.9 1.0 } + T{ gray f 1.0 1.0 } } } ; : selected-gradient T{ gradient f { - T{ rgba f 0.65 0.65 0.65 1.0 } - T{ rgba f 0.8 0.8 0.8 1.0 } - T{ rgba f 0.8 0.8 0.8 1.0 } - T{ rgba f 1.0 1.0 1.0 1.0 } + T{ gray f 0.65 1.0 } + T{ gray f 0.8 1.0 } + T{ gray f 0.8 1.0 } + T{ gray f 1.0 1.0 } } } ; : lowered-gradient T{ gradient f { - T{ rgba f 0.37 0.37 0.37 1.0 } - T{ rgba f 0.43 0.43 0.43 1.0 } - T{ rgba f 0.5 0.5 0.5 1.0 } + T{ gray f 0.37 1.0 } + T{ gray f 0.43 1.0 } + T{ gray f 0.5 1.0 } } } ; : sans-serif-font { "sans-serif" plain 12 } ; diff --git a/extra/ui/gadgets/tiling/tiling.factor b/basis/ui/gadgets/tiling/tiling.factor similarity index 100% rename from extra/ui/gadgets/tiling/tiling.factor rename to basis/ui/gadgets/tiling/tiling.factor diff --git a/extra/ui/gadgets/tracks/authors.txt b/basis/ui/gadgets/tracks/authors.txt similarity index 100% rename from extra/ui/gadgets/tracks/authors.txt rename to basis/ui/gadgets/tracks/authors.txt diff --git a/extra/ui/gadgets/tracks/summary.txt b/basis/ui/gadgets/tracks/summary.txt similarity index 100% rename from extra/ui/gadgets/tracks/summary.txt rename to basis/ui/gadgets/tracks/summary.txt diff --git a/extra/ui/gadgets/tracks/tracks-docs.factor b/basis/ui/gadgets/tracks/tracks-docs.factor similarity index 100% rename from extra/ui/gadgets/tracks/tracks-docs.factor rename to basis/ui/gadgets/tracks/tracks-docs.factor diff --git a/extra/ui/gadgets/tracks/tracks-tests.factor b/basis/ui/gadgets/tracks/tracks-tests.factor similarity index 100% rename from extra/ui/gadgets/tracks/tracks-tests.factor rename to basis/ui/gadgets/tracks/tracks-tests.factor diff --git a/extra/ui/gadgets/tracks/tracks.factor b/basis/ui/gadgets/tracks/tracks.factor similarity index 100% rename from extra/ui/gadgets/tracks/tracks.factor rename to basis/ui/gadgets/tracks/tracks.factor diff --git a/extra/ui/gadgets/viewports/authors.txt b/basis/ui/gadgets/viewports/authors.txt similarity index 100% rename from extra/ui/gadgets/viewports/authors.txt rename to basis/ui/gadgets/viewports/authors.txt diff --git a/extra/ui/gadgets/viewports/summary.txt b/basis/ui/gadgets/viewports/summary.txt similarity index 100% rename from extra/ui/gadgets/viewports/summary.txt rename to basis/ui/gadgets/viewports/summary.txt diff --git a/extra/ui/gadgets/viewports/viewports-docs.factor b/basis/ui/gadgets/viewports/viewports-docs.factor similarity index 100% rename from extra/ui/gadgets/viewports/viewports-docs.factor rename to basis/ui/gadgets/viewports/viewports-docs.factor diff --git a/extra/ui/gadgets/viewports/viewports.factor b/basis/ui/gadgets/viewports/viewports.factor similarity index 100% rename from extra/ui/gadgets/viewports/viewports.factor rename to basis/ui/gadgets/viewports/viewports.factor diff --git a/extra/ui/gadgets/worlds/authors.txt b/basis/ui/gadgets/worlds/authors.txt similarity index 100% rename from extra/ui/gadgets/worlds/authors.txt rename to basis/ui/gadgets/worlds/authors.txt diff --git a/extra/ui/gadgets/worlds/summary.txt b/basis/ui/gadgets/worlds/summary.txt similarity index 100% rename from extra/ui/gadgets/worlds/summary.txt rename to basis/ui/gadgets/worlds/summary.txt diff --git a/extra/ui/gadgets/worlds/worlds-docs.factor b/basis/ui/gadgets/worlds/worlds-docs.factor similarity index 100% rename from extra/ui/gadgets/worlds/worlds-docs.factor rename to basis/ui/gadgets/worlds/worlds-docs.factor diff --git a/extra/ui/gadgets/worlds/worlds-tests.factor b/basis/ui/gadgets/worlds/worlds-tests.factor similarity index 100% rename from extra/ui/gadgets/worlds/worlds-tests.factor rename to basis/ui/gadgets/worlds/worlds-tests.factor diff --git a/extra/ui/gadgets/worlds/worlds.factor b/basis/ui/gadgets/worlds/worlds.factor similarity index 100% rename from extra/ui/gadgets/worlds/worlds.factor rename to basis/ui/gadgets/worlds/worlds.factor diff --git a/extra/ui/gadgets/wrappers/wrappers.factor b/basis/ui/gadgets/wrappers/wrappers.factor similarity index 100% rename from extra/ui/gadgets/wrappers/wrappers.factor rename to basis/ui/gadgets/wrappers/wrappers.factor diff --git a/extra/ui/gestures/authors.txt b/basis/ui/gestures/authors.txt similarity index 100% rename from extra/ui/gestures/authors.txt rename to basis/ui/gestures/authors.txt diff --git a/extra/ui/gestures/gestures-docs.factor b/basis/ui/gestures/gestures-docs.factor similarity index 100% rename from extra/ui/gestures/gestures-docs.factor rename to basis/ui/gestures/gestures-docs.factor diff --git a/extra/ui/gestures/gestures.factor b/basis/ui/gestures/gestures.factor similarity index 100% rename from extra/ui/gestures/gestures.factor rename to basis/ui/gestures/gestures.factor diff --git a/extra/ui/gestures/summary.txt b/basis/ui/gestures/summary.txt similarity index 100% rename from extra/ui/gestures/summary.txt rename to basis/ui/gestures/summary.txt diff --git a/extra/ui/operations/authors.txt b/basis/ui/operations/authors.txt similarity index 100% rename from extra/ui/operations/authors.txt rename to basis/ui/operations/authors.txt diff --git a/extra/ui/operations/operations-docs.factor b/basis/ui/operations/operations-docs.factor similarity index 100% rename from extra/ui/operations/operations-docs.factor rename to basis/ui/operations/operations-docs.factor diff --git a/extra/ui/operations/operations-tests.factor b/basis/ui/operations/operations-tests.factor similarity index 100% rename from extra/ui/operations/operations-tests.factor rename to basis/ui/operations/operations-tests.factor diff --git a/extra/ui/operations/operations.factor b/basis/ui/operations/operations.factor similarity index 100% rename from extra/ui/operations/operations.factor rename to basis/ui/operations/operations.factor diff --git a/extra/ui/operations/summary.txt b/basis/ui/operations/summary.txt similarity index 100% rename from extra/ui/operations/summary.txt rename to basis/ui/operations/summary.txt diff --git a/extra/ui/render/authors.txt b/basis/ui/render/authors.txt similarity index 100% rename from extra/ui/render/authors.txt rename to basis/ui/render/authors.txt diff --git a/extra/ui/render/render-docs.factor b/basis/ui/render/render-docs.factor similarity index 100% rename from extra/ui/render/render-docs.factor rename to basis/ui/render/render-docs.factor diff --git a/extra/ui/render/render.factor b/basis/ui/render/render.factor similarity index 100% rename from extra/ui/render/render.factor rename to basis/ui/render/render.factor diff --git a/extra/ui/render/summary.txt b/basis/ui/render/summary.txt similarity index 100% rename from extra/ui/render/summary.txt rename to basis/ui/render/summary.txt diff --git a/extra/ui/summary.txt b/basis/ui/summary.txt similarity index 100% rename from extra/ui/summary.txt rename to basis/ui/summary.txt diff --git a/extra/ui/tools/authors.txt b/basis/ui/tools/authors.txt similarity index 100% rename from extra/ui/tools/authors.txt rename to basis/ui/tools/authors.txt diff --git a/extra/ui/tools/browser/authors.txt b/basis/ui/tools/browser/authors.txt similarity index 100% rename from extra/ui/tools/browser/authors.txt rename to basis/ui/tools/browser/authors.txt diff --git a/extra/ui/tools/browser/browser-tests.factor b/basis/ui/tools/browser/browser-tests.factor similarity index 100% rename from extra/ui/tools/browser/browser-tests.factor rename to basis/ui/tools/browser/browser-tests.factor diff --git a/extra/ui/tools/browser/browser.factor b/basis/ui/tools/browser/browser.factor similarity index 100% rename from extra/ui/tools/browser/browser.factor rename to basis/ui/tools/browser/browser.factor diff --git a/extra/ui/tools/browser/summary.txt b/basis/ui/tools/browser/summary.txt similarity index 100% rename from extra/ui/tools/browser/summary.txt rename to basis/ui/tools/browser/summary.txt diff --git a/extra/ui/tools/browser/tags.txt b/basis/ui/tools/browser/tags.txt similarity index 100% rename from extra/ui/tools/browser/tags.txt rename to basis/ui/tools/browser/tags.txt diff --git a/extra/ui/tools/debugger/authors.txt b/basis/ui/tools/debugger/authors.txt similarity index 100% rename from extra/ui/tools/debugger/authors.txt rename to basis/ui/tools/debugger/authors.txt diff --git a/extra/ui/tools/debugger/debugger-docs.factor b/basis/ui/tools/debugger/debugger-docs.factor similarity index 100% rename from extra/ui/tools/debugger/debugger-docs.factor rename to basis/ui/tools/debugger/debugger-docs.factor diff --git a/extra/ui/tools/debugger/debugger.factor b/basis/ui/tools/debugger/debugger.factor similarity index 100% rename from extra/ui/tools/debugger/debugger.factor rename to basis/ui/tools/debugger/debugger.factor diff --git a/extra/ui/tools/debugger/summary.txt b/basis/ui/tools/debugger/summary.txt similarity index 100% rename from extra/ui/tools/debugger/summary.txt rename to basis/ui/tools/debugger/summary.txt diff --git a/extra/ui/tools/debugger/tags.txt b/basis/ui/tools/debugger/tags.txt similarity index 100% rename from extra/ui/tools/debugger/tags.txt rename to basis/ui/tools/debugger/tags.txt diff --git a/extra/ui/tools/deploy/authors.txt b/basis/ui/tools/deploy/authors.txt similarity index 100% rename from extra/ui/tools/deploy/authors.txt rename to basis/ui/tools/deploy/authors.txt diff --git a/extra/ui/tools/deploy/deploy-docs.factor b/basis/ui/tools/deploy/deploy-docs.factor similarity index 100% rename from extra/ui/tools/deploy/deploy-docs.factor rename to basis/ui/tools/deploy/deploy-docs.factor diff --git a/extra/ui/tools/deploy/deploy.factor b/basis/ui/tools/deploy/deploy.factor similarity index 100% rename from extra/ui/tools/deploy/deploy.factor rename to basis/ui/tools/deploy/deploy.factor diff --git a/extra/ui/tools/inspector/authors.txt b/basis/ui/tools/inspector/authors.txt similarity index 100% rename from extra/ui/tools/inspector/authors.txt rename to basis/ui/tools/inspector/authors.txt diff --git a/extra/ui/tools/inspector/inspector.factor b/basis/ui/tools/inspector/inspector.factor similarity index 100% rename from extra/ui/tools/inspector/inspector.factor rename to basis/ui/tools/inspector/inspector.factor diff --git a/extra/ui/tools/inspector/summary.txt b/basis/ui/tools/inspector/summary.txt similarity index 100% rename from extra/ui/tools/inspector/summary.txt rename to basis/ui/tools/inspector/summary.txt diff --git a/extra/ui/tools/inspector/tags.txt b/basis/ui/tools/inspector/tags.txt similarity index 100% rename from extra/ui/tools/inspector/tags.txt rename to basis/ui/tools/inspector/tags.txt diff --git a/extra/ui/tools/interactor/authors.txt b/basis/ui/tools/interactor/authors.txt similarity index 100% rename from extra/ui/tools/interactor/authors.txt rename to basis/ui/tools/interactor/authors.txt diff --git a/extra/ui/tools/interactor/interactor-docs.factor b/basis/ui/tools/interactor/interactor-docs.factor similarity index 100% rename from extra/ui/tools/interactor/interactor-docs.factor rename to basis/ui/tools/interactor/interactor-docs.factor diff --git a/extra/ui/tools/interactor/interactor-tests.factor b/basis/ui/tools/interactor/interactor-tests.factor similarity index 100% rename from extra/ui/tools/interactor/interactor-tests.factor rename to basis/ui/tools/interactor/interactor-tests.factor diff --git a/extra/ui/tools/interactor/interactor.factor b/basis/ui/tools/interactor/interactor.factor similarity index 100% rename from extra/ui/tools/interactor/interactor.factor rename to basis/ui/tools/interactor/interactor.factor diff --git a/extra/ui/tools/interactor/summary.txt b/basis/ui/tools/interactor/summary.txt similarity index 100% rename from extra/ui/tools/interactor/summary.txt rename to basis/ui/tools/interactor/summary.txt diff --git a/extra/ui/tools/listener/authors.txt b/basis/ui/tools/listener/authors.txt similarity index 100% rename from extra/ui/tools/listener/authors.txt rename to basis/ui/tools/listener/authors.txt diff --git a/extra/ui/tools/listener/listener-tests.factor b/basis/ui/tools/listener/listener-tests.factor similarity index 100% rename from extra/ui/tools/listener/listener-tests.factor rename to basis/ui/tools/listener/listener-tests.factor diff --git a/extra/ui/tools/listener/listener.factor b/basis/ui/tools/listener/listener.factor similarity index 100% rename from extra/ui/tools/listener/listener.factor rename to basis/ui/tools/listener/listener.factor diff --git a/extra/ui/tools/listener/summary.txt b/basis/ui/tools/listener/summary.txt similarity index 100% rename from extra/ui/tools/listener/summary.txt rename to basis/ui/tools/listener/summary.txt diff --git a/extra/ui/tools/listener/tags.txt b/basis/ui/tools/listener/tags.txt similarity index 100% rename from extra/ui/tools/listener/tags.txt rename to basis/ui/tools/listener/tags.txt diff --git a/extra/ui/tools/operations/authors.txt b/basis/ui/tools/operations/authors.txt similarity index 100% rename from extra/ui/tools/operations/authors.txt rename to basis/ui/tools/operations/authors.txt diff --git a/extra/ui/tools/operations/operations.factor b/basis/ui/tools/operations/operations.factor similarity index 100% rename from extra/ui/tools/operations/operations.factor rename to basis/ui/tools/operations/operations.factor diff --git a/extra/ui/tools/operations/summary.txt b/basis/ui/tools/operations/summary.txt similarity index 100% rename from extra/ui/tools/operations/summary.txt rename to basis/ui/tools/operations/summary.txt diff --git a/extra/ui/tools/profiler/authors.txt b/basis/ui/tools/profiler/authors.txt similarity index 100% rename from extra/ui/tools/profiler/authors.txt rename to basis/ui/tools/profiler/authors.txt diff --git a/extra/ui/tools/profiler/profiler.factor b/basis/ui/tools/profiler/profiler.factor similarity index 100% rename from extra/ui/tools/profiler/profiler.factor rename to basis/ui/tools/profiler/profiler.factor diff --git a/extra/ui/tools/profiler/summary.txt b/basis/ui/tools/profiler/summary.txt similarity index 100% rename from extra/ui/tools/profiler/summary.txt rename to basis/ui/tools/profiler/summary.txt diff --git a/extra/ui/tools/profiler/tags.txt b/basis/ui/tools/profiler/tags.txt similarity index 100% rename from extra/ui/tools/profiler/tags.txt rename to basis/ui/tools/profiler/tags.txt diff --git a/extra/ui/tools/search/authors.txt b/basis/ui/tools/search/authors.txt similarity index 100% rename from extra/ui/tools/search/authors.txt rename to basis/ui/tools/search/authors.txt diff --git a/extra/ui/tools/search/search-tests.factor b/basis/ui/tools/search/search-tests.factor similarity index 100% rename from extra/ui/tools/search/search-tests.factor rename to basis/ui/tools/search/search-tests.factor diff --git a/extra/ui/tools/search/search.factor b/basis/ui/tools/search/search.factor similarity index 100% rename from extra/ui/tools/search/search.factor rename to basis/ui/tools/search/search.factor diff --git a/extra/ui/tools/search/summary.txt b/basis/ui/tools/search/summary.txt similarity index 100% rename from extra/ui/tools/search/summary.txt rename to basis/ui/tools/search/summary.txt diff --git a/extra/ui/tools/summary.txt b/basis/ui/tools/summary.txt similarity index 100% rename from extra/ui/tools/summary.txt rename to basis/ui/tools/summary.txt diff --git a/extra/ui/tools/tags.txt b/basis/ui/tools/tags.txt similarity index 100% rename from extra/ui/tools/tags.txt rename to basis/ui/tools/tags.txt diff --git a/extra/ui/tools/tools-docs.factor b/basis/ui/tools/tools-docs.factor similarity index 100% rename from extra/ui/tools/tools-docs.factor rename to basis/ui/tools/tools-docs.factor diff --git a/extra/ui/tools/tools-tests.factor b/basis/ui/tools/tools-tests.factor similarity index 100% rename from extra/ui/tools/tools-tests.factor rename to basis/ui/tools/tools-tests.factor diff --git a/extra/ui/tools/tools.factor b/basis/ui/tools/tools.factor similarity index 100% rename from extra/ui/tools/tools.factor rename to basis/ui/tools/tools.factor diff --git a/extra/ui/tools/traceback/authors.txt b/basis/ui/tools/traceback/authors.txt similarity index 100% rename from extra/ui/tools/traceback/authors.txt rename to basis/ui/tools/traceback/authors.txt diff --git a/extra/ui/tools/traceback/summary.txt b/basis/ui/tools/traceback/summary.txt similarity index 100% rename from extra/ui/tools/traceback/summary.txt rename to basis/ui/tools/traceback/summary.txt diff --git a/extra/ui/tools/traceback/traceback.factor b/basis/ui/tools/traceback/traceback.factor similarity index 100% rename from extra/ui/tools/traceback/traceback.factor rename to basis/ui/tools/traceback/traceback.factor diff --git a/extra/ui/tools/walker/authors.txt b/basis/ui/tools/walker/authors.txt similarity index 100% rename from extra/ui/tools/walker/authors.txt rename to basis/ui/tools/walker/authors.txt diff --git a/extra/ui/tools/walker/summary.txt b/basis/ui/tools/walker/summary.txt similarity index 100% rename from extra/ui/tools/walker/summary.txt rename to basis/ui/tools/walker/summary.txt diff --git a/extra/ui/tools/walker/tags.txt b/basis/ui/tools/walker/tags.txt similarity index 100% rename from extra/ui/tools/walker/tags.txt rename to basis/ui/tools/walker/tags.txt diff --git a/extra/ui/tools/walker/walker-docs.factor b/basis/ui/tools/walker/walker-docs.factor similarity index 100% rename from extra/ui/tools/walker/walker-docs.factor rename to basis/ui/tools/walker/walker-docs.factor diff --git a/extra/ui/tools/walker/walker-tests.factor b/basis/ui/tools/walker/walker-tests.factor similarity index 100% rename from extra/ui/tools/walker/walker-tests.factor rename to basis/ui/tools/walker/walker-tests.factor diff --git a/extra/ui/tools/walker/walker.factor b/basis/ui/tools/walker/walker.factor similarity index 100% rename from extra/ui/tools/walker/walker.factor rename to basis/ui/tools/walker/walker.factor diff --git a/extra/ui/tools/workspace/authors.txt b/basis/ui/tools/workspace/authors.txt similarity index 100% rename from extra/ui/tools/workspace/authors.txt rename to basis/ui/tools/workspace/authors.txt diff --git a/extra/ui/tools/workspace/summary.txt b/basis/ui/tools/workspace/summary.txt similarity index 100% rename from extra/ui/tools/workspace/summary.txt rename to basis/ui/tools/workspace/summary.txt diff --git a/extra/ui/tools/workspace/tags.txt b/basis/ui/tools/workspace/tags.txt similarity index 100% rename from extra/ui/tools/workspace/tags.txt rename to basis/ui/tools/workspace/tags.txt diff --git a/extra/ui/tools/workspace/workspace-tests.factor b/basis/ui/tools/workspace/workspace-tests.factor similarity index 100% rename from extra/ui/tools/workspace/workspace-tests.factor rename to basis/ui/tools/workspace/workspace-tests.factor diff --git a/extra/ui/tools/workspace/workspace.factor b/basis/ui/tools/workspace/workspace.factor similarity index 100% rename from extra/ui/tools/workspace/workspace.factor rename to basis/ui/tools/workspace/workspace.factor diff --git a/extra/ui/traverse/authors.txt b/basis/ui/traverse/authors.txt similarity index 100% rename from extra/ui/traverse/authors.txt rename to basis/ui/traverse/authors.txt diff --git a/extra/ui/traverse/summary.txt b/basis/ui/traverse/summary.txt similarity index 100% rename from extra/ui/traverse/summary.txt rename to basis/ui/traverse/summary.txt diff --git a/extra/ui/traverse/traverse-tests.factor b/basis/ui/traverse/traverse-tests.factor similarity index 100% rename from extra/ui/traverse/traverse-tests.factor rename to basis/ui/traverse/traverse-tests.factor diff --git a/extra/ui/traverse/traverse.factor b/basis/ui/traverse/traverse.factor similarity index 100% rename from extra/ui/traverse/traverse.factor rename to basis/ui/traverse/traverse.factor diff --git a/extra/ui/ui-docs.factor b/basis/ui/ui-docs.factor similarity index 100% rename from extra/ui/ui-docs.factor rename to basis/ui/ui-docs.factor diff --git a/extra/ui/ui.factor b/basis/ui/ui.factor similarity index 100% rename from extra/ui/ui.factor rename to basis/ui/ui.factor diff --git a/extra/ui/windows/authors.txt b/basis/ui/windows/authors.txt similarity index 100% rename from extra/ui/windows/authors.txt rename to basis/ui/windows/authors.txt diff --git a/extra/ui/windows/tags.txt b/basis/ui/windows/tags.txt similarity index 100% rename from extra/ui/windows/tags.txt rename to basis/ui/windows/tags.txt diff --git a/extra/ui/windows/windows.factor b/basis/ui/windows/windows.factor similarity index 100% rename from extra/ui/windows/windows.factor rename to basis/ui/windows/windows.factor diff --git a/extra/ui/x11/authors.txt b/basis/ui/x11/authors.txt similarity index 100% rename from extra/ui/x11/authors.txt rename to basis/ui/x11/authors.txt diff --git a/extra/ui/x11/tags.txt b/basis/ui/x11/tags.txt similarity index 100% rename from extra/ui/x11/tags.txt rename to basis/ui/x11/tags.txt diff --git a/extra/ui/x11/x11.factor b/basis/ui/x11/x11.factor similarity index 100% rename from extra/ui/x11/x11.factor rename to basis/ui/x11/x11.factor diff --git a/core/effects/effects.factor b/core/effects/effects.factor index c221ad073b..2e0aa4c279 100755 --- a/core/effects/effects.factor +++ b/core/effects/effects.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math namespaces sequences strings words assocs -combinators accessors arrays ; +USING: kernel math math.parser namespaces sequences strings +words assocs combinators accessors arrays ; IN: effects TUPLE: effect in out terminated? ; @@ -25,10 +25,11 @@ TUPLE: effect in out terminated? ; GENERIC: effect>string ( obj -- str ) M: string effect>string ; M: word effect>string name>> ; -M: integer effect>string drop "object" ; +M: integer effect>string number>string ; M: pair effect>string first2 [ effect>string ] bi@ ": " swap 3append ; : stack-picture ( seq -- string ) + dup integer? [ "object" ] when [ [ effect>string % CHAR: \s , ] each ] "" make ; M: effect effect>string ( effect -- string ) diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor index 0a1a3cb7f2..94f0ddea51 100755 --- a/core/kernel/kernel-docs.factor +++ b/core/kernel/kernel-docs.factor @@ -629,7 +629,7 @@ HELP: 2bi* "The following two lines are equivalent:" { $code "[ p ] [ q ] 2bi*" - ">r >r q r> r> q" + ">r >r p r> r> q" } } ; diff --git a/extra/24-game/24-game-docs.factor b/extra/24-game/24-game-docs.factor new file mode 100644 index 0000000000..12a558b2d2 --- /dev/null +++ b/extra/24-game/24-game-docs.factor @@ -0,0 +1,67 @@ +USING: help.markup help.syntax math kernel ; +IN: 24-game + +HELP: play-game ( -- ) +{ $description "Starts the game!" } +{ $examples + { $unchecked-example + "USE: 24-game" + "play-game" + "{ 8 2 1 2 }\n" + "Commands: { + - * / rot swap q }\n" + "swap\n" + "{ 8 2 2 1 }\n" + "Commands: { + - * / rot swap q }\n" + "-\n" + "{ 8 2 1 }\n" + "Commands: { + - * / rot swap q }\n" + "+\n" + "{ 8 3 }\n" + "Commands: { + - * / swap q }\n" + "*\n" + "You WON!" + } +} ; + +HELP: 24-able ( -- vector ) +{ $values { "vector" "vector of 4 integers" } } +{ $description + "Produces a vector with 4 integers. With the following condition: " + "If these integers were directly on the stack, one can process them into 24, " + "just using the provided commands and the 4 numbers. The Following are the " + "provided commands: " + { $link + } ", " { $link - } ", " { $link * } ", " + { $link / } ", and " { $link swap } "." +} +{ $examples + { $example + "USE: 24-game" + "24-able vector-24-able?" + "t" + } + { $notes { $link 24-able? } " is used in " { $link 24-able } "." } +} ; + +HELP: 24-able? ( quad -- t/f ) +{ $values + { "quad" "vector of 4 integers" } + { "t/f" "a boolean" } +} +{ $description + "Tells if it is possible to win 24-game if it was initiated " + "with this sequence." +} ; + +HELP: build-quad ( -- array ) +{ $values + { "vector" "an array of 4 numbers" } +} +{ $description "Builds an array of 4 random numbers." } ; +ARTICLE: "24-game" "The Game of 24" +"A classic math game, where one attempts to create 24, by applying " +"arithmetical operations and some shuffle words to a stack of 4 numbers. " +{ $subsection play-game } +{ $subsection 24-able } +{ $subsection 24-able? } +{ $subsection build-quad } ; +ABOUT: "24-game" \ No newline at end of file diff --git a/extra/24-game/24-game.factor b/extra/24-game/24-game.factor index 569cef8302..52f0cd6833 100644 --- a/extra/24-game/24-game.factor +++ b/extra/24-game/24-game.factor @@ -3,36 +3,60 @@ USING: kernel random namespaces shuffle sequences parser io math prettyprint combinators continuations -vectors words quotations accessors math.parser -backtrack math.ranges locals fry memoize macros assocs ; +arrays words quotations accessors math.parser backtrack assocs ; IN: 24-game - +SYMBOL: commands : nop ; : do-something ( a b -- c ) { + - * } amb-execute ; : maybe-swap ( a b -- a b ) { nop swap } amb-execute ; : some-rots ( a b c -- a b c ) #! Try each permutation of 3 elements. { nop rot -rot swap spin swapd } amb-execute ; -: makes-24? ( a b c d -- ? ) [ some-rots do-something some-rots do-something maybe-swap do-something 24 = ] [ 4drop ] if-amb ; -: vector-24-able? ( vector -- t/f ) [ makes-24? ] with-datastack first ; +: makes-24? ( a b c d -- ? ) + [ + 2 [ some-rots do-something ] times + maybe-swap do-something + 24 = + ] + [ 4drop ] + if-amb ; : q ( -- obj ) "quit" ; -: show-commands ( -- ) "Commands: " write "commands" get unparse print ; +: show-commands ( -- ) "Commands: " write commands get unparse print ; : report ( vector -- ) unparse print show-commands ; : give-help ( -- ) "Command not found..." print show-commands ; : find-word ( string choices -- word ) [ name>> = ] with find nip ; -: obtain-word ( -- word ) readln "commands" get find-word dup [ drop give-help obtain-word ] unless ; +: obtain-word ( -- word ) + readln commands get find-word dup + [ drop give-help obtain-word ] unless ; : done? ( vector -- t/f ) 1 swap length = ; -: victory? ( vector -- t/f ) V{ 24 } = ; -: apply-word ( vector word -- vector ) 1quotation with-datastack >vector ; -: update-commands ( vector -- ) length 3 < [ "commands" [ \ rot swap remove ] change ] [ ] if ; +: victory? ( vector -- t/f ) { 24 } = ; +: apply-word ( vector word -- array ) 1quotation with-datastack >array ; +: update-commands ( vector -- ) + length 3 < + [ commands [ \ rot swap remove ] change ] + [ ] + if ; DEFER: check-status : quit-game ( vector -- ) drop "you're a quitter" print ; : quit? ( vector -- t/f ) peek "quit" = ; -: end-game ( vector -- ) dup victory? [ drop "You WON!" ] [ pop number>string " is not 24... You lose." append ] if print ; -: repeat ( vector -- ) dup report obtain-word apply-word dup update-commands check-status ; -: check-status ( object -- ) dup done? [ end-game ] [ dup quit? [ quit-game ] [ repeat ] if ] if ; -: build-quad ( -- vector ) 4 [ 10 random ] replicate >vector ; -: 24-able ( -- vector ) build-quad dup vector-24-able? [ drop build-quad ] unless ; -: set-commands ( -- ) { + - * / rot swap q } "commands" set ; +: end-game ( vector -- ) + dup victory? + [ drop "You WON!" ] + [ pop number>string " is not 24... You lose." append ] + if print ; + +! The following two words are mutually recursive, +! providing the repl loop of the game +: repeat ( vector -- ) + dup report obtain-word apply-word dup update-commands check-status ; +: check-status ( object -- ) + dup done? + [ end-game ] + [ dup quit? [ quit-game ] [ repeat ] if ] + if ; +: build-quad ( -- array ) 4 [ 10 random ] replicate >array ; +: 24-able? ( vector -- t/f ) [ makes-24? ] with-datastack first ; +: 24-able ( -- vector ) build-quad dup 24-able? [ drop build-quad ] unless ; +: set-commands ( -- ) { + - * / rot swap q } commands set ; : play-game ( -- ) set-commands 24-able repeat ; \ No newline at end of file diff --git a/extra/24-game/authors.txt b/extra/24-game/authors.txt new file mode 100644 index 0000000000..137b1605da --- /dev/null +++ b/extra/24-game/authors.txt @@ -0,0 +1 @@ +Reginald Ford \ No newline at end of file diff --git a/extra/24-game/tags.txt b/extra/24-game/tags.txt index cb5fc203e1..d2f0464fdb 100644 --- a/extra/24-game/tags.txt +++ b/extra/24-game/tags.txt @@ -1 +1,2 @@ demos +games \ No newline at end of file diff --git a/extra/backtrack/backtrack.factor b/extra/backtrack/backtrack.factor index 3c1a794121..db2c50173c 100755 --- a/extra/backtrack/backtrack.factor +++ b/extra/backtrack/backtrack.factor @@ -66,3 +66,5 @@ MACRO: amb-execute ( seq -- quot ) tri* if ] with-scope ; inline +: cut-amb ( -- ) + f failure set ; diff --git a/extra/cfdg/models/game1-turn6/game1-turn6.factor b/extra/cfdg/models/game1-turn6/game1-turn6.factor index 3e0994112a..5e512cd74a 100644 --- a/extra/cfdg/models/game1-turn6/game1-turn6.factor +++ b/extra/cfdg/models/game1-turn6/game1-turn6.factor @@ -6,29 +6,35 @@ IN: cfdg.models.game1-turn6 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: f-triangles ( -- ) iterate? [ -[ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.8 b triangle ] do -[ 10 hue 0.9 sat 0.33 b triangle ] do -[ 0.9 s 10 hue 0.5 sat 1 b triangle ] do -[ 0.8 s 5 r f-triangles ] do -] when ; +: f-triangles ( -- ) + { + [ 0.1 x 0.1 y -0.33 alpha 20 hue 0.7 sat 0.80 b triangle ] + [ 10 hue 0.9 sat 0.33 b triangle ] + [ 0.9 s 10 hue 0.5 sat 1.00 b triangle ] + [ 0.8 s 5 r f-triangles ] + } + rule ; -: f-squares ( -- ) iterate? [ -[ 0.1 x 0.1 y -0.33 alpha 250 hue 0.7 sat 0.8 b square ] do -[ 220 hue 0.9 sat 0.33 b square ] do -[ 0.9 s 220 hue 0.25 sat 1 b square ] do -[ 0.8 s 5 r f-squares ] do -] when ; +: f-squares ( -- ) + { + [ 0.1 x 0.1 y -0.33 alpha 250 hue 0.70 sat 0.80 b square ] + [ 220 hue 0.90 sat 0.33 b square ] + [ 0.9 s 220 hue 0.25 sat 1.00 b square ] + [ 0.8 s 5 r f-squares ] + } + rule ; DEFER: start -: spiral ( -- ) iterate? [ - { { 1 [ f-squares - [ 0.5 x 0.5 y 45 r f-triangles ] do - [ 1 y 25 r 0.9 s spiral ] do ] } - { 0.022 [ [ 90 flip 50 hue start ] do ] } } - call-random-weighted -] when ; +: spiral ( -- ) + { + { 1 [ f-squares ] + [ 0.5 x 0.5 y 45 r f-triangles ] + [ 1 y 25 r 0.9 s spiral ] } + + { 0.022 [ 90 flip 50 hue start ] } + } + rules ; : start ( -- ) [ spiral ] do diff --git a/extra/cfdg/models/rules08/rules08.factor b/extra/cfdg/models/rules08/rules08.factor index 20099d225a..f5398582c9 100644 --- a/extra/cfdg/models/rules08/rules08.factor +++ b/extra/cfdg/models/rules08/rules08.factor @@ -17,37 +17,21 @@ DEFER: line : ligne ( -- ) { - { 1 [ 4.5 y 1.15 0.8 size* -0.3 b line ] do } + { 1 [ 4.5 y 1.15 0.8 size* -0.3 b line ] } { 0.5 [ ] } } - call-random-weighted ; + rules ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: line ( -- ) [ insct ligne ] recursive ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +: line ( -- ) { [ insct ligne ] } rule ; : sole ( -- ) - [ - { - { - 1 [ - [ 1 brightness 0.5 saturation ligne ] do - [ 140 r 1 hue sole ] do - ] - } - { 0.01 [ ] } - } - call-random-weighted - ] - recursive ; + { + { 1 [ 1 brightness 0.5 saturation ligne ] [ 140 r 1 hue sole ] } + { 0.01 [ ] } + } + rules ; -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: centre ( -- ) - [ 1 b 5 s circle ] do - [ sole ] do ; +: centre ( -- ) { [ 1 b 5 s circle ] [ sole ] } rule ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/extra/cfdg/models/spirales/spirales.factor b/extra/cfdg/models/spirales/spirales.factor index 985c21643e..f804b6ba83 100644 --- a/extra/cfdg/models/spirales/spirales.factor +++ b/extra/cfdg/models/spirales/spirales.factor @@ -7,33 +7,19 @@ DEFER: line ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: block ( -- ) - [ - [ circle ] do - [ 0.3 s 60 flip line ] do - ] - recursive ; +: block ( -- ) { [ circle ] [ 0.3 s 60 flip line ] } rule ; -: a1 ( -- ) - [ - [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] do - [ block ] do - ] - recursive ; +: a1 ( -- ) { [ 0.95 s 2 x 12 r 0.5 b 10 hue 1.5 sat a1 ] [ block ] } rule ; -: line ( -- ) - -0.3 a - [ 0 rotate a1 ] do - [ 120 rotate a1 ] do - [ 240 rotate a1 ] do ; +: line ( -- ) -0.3 a { [ 0 r a1 ] [ 120 r a1 ] [ 240 r a1 ] } rule ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : init ( -- ) - [ -1 b ] >background - { -20 40 -20 40 } viewport set - [ line ] >start-shape - 0.03 >threshold ; + [ -1 b ] >background + { -20 40 -20 40 } >viewport + [ line ] >start-shape + 0.04 >threshold ; : run ( -- ) [ init ] cfdg-window. ; diff --git a/extra/game-input/backend/backend.factor b/extra/game-input/backend/backend.factor index a31b9d6649..cfba0a52f5 100644 --- a/extra/game-input/backend/backend.factor +++ b/extra/game-input/backend/backend.factor @@ -1,4 +1,4 @@ -USING: multiline system parser combinators ; +USING: eval multiline system combinators ; IN: game-input.backend STRING: set-backend-for-macosx diff --git a/extra/irc/client/client-tests.factor b/extra/irc/client/client-tests.factor index 1b338df442..2b4b501952 100644 --- a/extra/irc/client/client-tests.factor +++ b/extra/irc/client/client-tests.factor @@ -1,190 +1,178 @@ USING: kernel tools.test accessors arrays sequences qualified - io.streams.string io.streams.duplex namespaces threads + io io.streams.duplex namespaces threads calendar irc.client.private irc.client irc.messages.private concurrency.mailboxes classes assocs combinators ; EXCLUDE: irc.messages => join ; RENAME: join irc.messages => join_ IN: irc.client.tests -! Utilities -: ( lines -- stream ) - "\n" join ; +! Streams for testing +TUPLE: mb-writer lines last-line disposed ; +TUPLE: mb-reader lines disposed ; +: ( -- mb-writer ) V{ } clone V{ } clone f mb-writer boa ; +: ( -- mb-reader ) f mb-reader boa ; +: push-line ( line test-reader-stream -- ) lines>> mailbox-put ; +: ( -- stream ) ; +M: mb-writer stream-write ( line mb-writer -- ) last-line>> push ; +M: mb-writer stream-flush ( mb-writer -- ) drop ; +M: mb-reader stream-readln ( mb-reader -- str/f ) lines>> mailbox-get ; +M: mb-writer stream-nl ( mb-writer -- ) + [ [ last-line>> concat ] [ lines>> ] bi push ] keep + V{ } clone >>last-line drop ; -: make-client ( lines -- irc-client ) - "someserver" irc-port "factorbot" f - swap [ 2nip f ] curry >>connect ; +: spawn-client ( lines listeners -- irc-client ) + "someserver" irc-port "factorbot" f + + t >>is-running + >>stream + dup [ spawn-irc yield ] with-irc-client ; -: set-nick ( irc-client nickname -- ) - swap profile>> (>>nickname) ; +! to be used inside with-irc-client quotations +: %add-named-listener ( listener -- ) [ name>> ] keep set+run-listener ; +: %join ( channel -- ) irc> add-listener ; +: %push-line ( line -- ) irc> stream>> in>> push-line yield ; -: with-dummy-client ( irc-client quot -- ) - [ current-irc-client ] dip with-variable ; inline +: read-matching-message ( listener quot: ( msg -- ? ) -- irc-message ) + [ in-messages>> 0.1 seconds ] dip mailbox-get-timeout? ; -{ "" } make-client dup "factorbot" set-nick [ - { t } [ irc> profile>> nickname>> me? ] unit-test +: with-irc ( quot: ( -- ) -- ) + [ spawn-client ] dip [ f %push-line ] compose with-irc-client ; inline - { "factorbot" } [ irc> profile>> nickname>> ] unit-test +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! TESTS +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test +[ { t } [ irc> profile>> nickname>> me? ] unit-test - { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi" - parse-irc-line irc-message-origin ] unit-test + { "factorbot" } [ irc> profile>> nickname>> ] unit-test - { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi" - parse-irc-line irc-message-origin ] unit-test -] with-dummy-client + { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test + + { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi" + parse-irc-line irc-message-origin ] unit-test + + { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi" + parse-irc-line irc-message-origin ] unit-test +] with-irc ! Test login and nickname set -{ "factorbot" } [ - { "NOTICE AUTH :*** Looking up your hostname..." - "NOTICE AUTH :*** Checking ident" - "NOTICE AUTH :*** Found your hostname" - "NOTICE AUTH :*** No identd (auth) response" - ":some.where 001 factorbot :Welcome factorbot" - } make-client - { [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ profile>> nickname>> ] - [ terminate-irc ] - } cleave ] unit-test +[ { "factorbot2" } [ + ":some.where 001 factorbot2 :Welcome factorbot2" %push-line + irc> profile>> nickname>> + ] unit-test +] with-irc -{ join_ "#factortest" } [ - { ":factorbot!n=factorbo@some.where JOIN :#factortest" - ":ircserver.net MODE #factortest +ns" - ":ircserver.net 353 factorbot @ #factortest :@factorbot " - ":ircserver.net 366 factorbot #factortest :End of /NAMES list." - ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" - } make-client - { [ "factorbot" set-nick ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ join-messages>> 0.1 seconds mailbox-get-timeout ] - [ terminate-irc ] - } cleave - [ class ] [ trailing>> ] bi ] unit-test +[ { join_ "#factortest" } [ + { ":factorbot!n=factorbo@some.where JOIN :#factortest" + ":ircserver.net 353 factorbot @ #factortest :@factorbot " + ":ircserver.net 366 factorbot #factortest :End of /NAMES list." + ":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah" + } [ %push-line ] each + irc> join-messages>> 0.1 seconds mailbox-get-timeout + [ class ] [ trailing>> ] bi + ] unit-test +] with-irc -{ +join+ "somebody" } [ - { ":somebody!n=somebody@some.where JOIN :#factortest" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "#factortest" ] dip at - [ read-message drop ] [ read-message drop ] [ read-message ] tri ] - [ terminate-irc ] - } cleave - [ action>> ] [ nick>> ] bi - ] unit-test +[ { T{ participant-changed f "somebody" +join+ } } [ + "#factortest" [ %add-named-listener ] keep + ":somebody!n=somebody@some.where JOIN :#factortest" %push-line + [ participant-changed? ] read-matching-message + ] unit-test +] with-irc -{ privmsg "#factortest" "hello" } [ - { ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "#factortest" ] dip at - [ read-message drop ] [ read-message ] bi ] - [ terminate-irc ] - } cleave - [ class ] [ name>> ] [ trailing>> ] tri - ] unit-test +[ { privmsg "#factortest" "hello" } [ + "#factortest" [ %add-named-listener ] keep + ":somebody!n=somebody@some.where PRIVMSG #factortest :hello" %push-line + [ privmsg? ] read-matching-message + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test +] with-irc -{ privmsg "factorbot" "hello" } [ - { ":somedude!n=user@isp.net PRIVMSG factorbot :hello" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "somedude" [ ] keep ] dip set-at ] - [ connect-irc ] - [ listeners>> [ "somedude" ] dip at - [ read-message drop ] [ read-message ] bi ] - [ terminate-irc ] - } cleave - [ class ] [ name>> ] [ trailing>> ] tri - ] unit-test +[ { privmsg "factorbot" "hello" } [ + "somedude" [ %add-named-listener ] keep + ":somedude!n=user@isp.net PRIVMSG factorbot :hello" %push-line + [ privmsg? ] read-matching-message + [ class ] [ name>> ] [ trailing>> ] tri + ] unit-test +] with-irc -! Participants lists tests -{ H{ { "somedude" +normal+ } } } [ - { ":somedude!n=user@isp.net JOIN :#factortest" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at participants>> ] - [ terminate-irc ] - } cleave - ] unit-test +[ { mode } [ + "#factortest" [ %add-named-listener ] keep + ":ircserver.net MODE #factortest +ns" %push-line + [ mode? ] read-matching-message class + ] unit-test +] with-irc -{ H{ { "somedude2" +normal+ } } } [ - { ":somedude!n=user@isp.net PART #factortest" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants ] keep - ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at participants>> ] - [ terminate-irc ] - } cleave - ] unit-test +! Participant lists tests +[ { H{ { "somedude" +normal+ } } } [ + "#factortest" [ %add-named-listener ] keep + ":somedude!n=user@isp.net JOIN :#factortest" %push-line + participants>> + ] unit-test +] with-irc -{ H{ { "somedude2" +normal+ } } } [ - { ":somedude!n=user@isp.net QUIT" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants ] keep - ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at participants>> ] - [ terminate-irc ] - } cleave - ] unit-test +[ { H{ { "somedude2" +normal+ } } } [ + "#factortest" + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude!n=user@isp.net PART #factortest" %push-line + participants>> + ] unit-test +] with-irc -{ H{ { "somedude2" +normal+ } } } [ - { ":somedude2!n=user2@isp.net KICK #factortest somedude" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ - H{ { "somedude2" +normal+ } - { "somedude" +normal+ } } clone >>participants ] keep - ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at participants>> ] - [ terminate-irc ] - } cleave - ] unit-test +[ { H{ { "somedude2" +normal+ } } } [ + "#factortest" + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude!n=user@isp.net QUIT" %push-line + participants>> + ] unit-test +] with-irc + +[ { H{ { "somedude2" +normal+ } } } [ + "#factortest" + H{ { "somedude2" +normal+ } + { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude2!n=user2@isp.net KICK #factortest somedude" %push-line + participants>> + ] unit-test +] with-irc + +[ { H{ { "somedude2" +normal+ } } } [ + "#factortest" + H{ { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude!n=user2@isp.net NICK :somedude2" %push-line + participants>> + ] unit-test +] with-irc ! Namelist change notification -{ T{ participant-changed f f f } } [ - { ":ircserver.net 353 factorbot @ #factortest :@factorbot " - ":ircserver.net 366 factorbot #factortest :End of /NAMES list." } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ ] keep ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at [ read-message drop ] [ read-message ] bi ] - [ terminate-irc ] - } cleave - ] unit-test +[ { T{ participant-changed f f f f } } [ + "#factortest" [ %add-named-listener ] keep + ":ircserver.net 353 factorbot @ #factortest :@factorbot " %push-line + ":ircserver.net 366 factorbot #factortest :End of /NAMES list." %push-line + [ participant-changed? ] read-matching-message + ] unit-test +] with-irc -{ T{ participant-changed f "somedude" +part+ } } [ - { ":somedude!n=user@isp.net QUIT" } make-client - { [ "factorbot" set-nick ] - [ listeners>> - [ "#factortest" [ - H{ { "somedude" +normal+ } } clone >>participants ] keep - ] dip set-at ] - [ connect-irc ] - [ drop 0.1 seconds sleep ] - [ listeners>> [ "#factortest" ] dip at - [ read-message drop ] [ read-message drop ] [ read-message ] tri ] - [ terminate-irc ] - } cleave - ] unit-test \ No newline at end of file +[ { T{ participant-changed f "somedude" +part+ f } } [ + "#factortest" + H{ { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude!n=user@isp.net QUIT" %push-line + [ participant-changed? ] read-matching-message + ] unit-test +] with-irc + +[ { T{ participant-changed f "somedude" +nick+ "somedude2" } } [ + "#factortest" + H{ { "somedude" +normal+ } } clone >>participants + [ %add-named-listener ] keep + ":somedude!n=user2@isp.net NICK :somedude2" %push-line + [ participant-changed? ] read-matching-message + ] unit-test +] with-irc diff --git a/extra/irc/client/client.factor b/extra/irc/client/client.factor index 99922b1fb5..e91767b22d 100644 --- a/extra/irc/client/client.factor +++ b/extra/irc/client/client.factor @@ -41,6 +41,7 @@ SYMBOL: +normal+ SYMBOL: +join+ SYMBOL: +part+ SYMBOL: +mode+ +SYMBOL: +nick+ ! listener objects : ( -- irc-listener ) irc-listener boa ; @@ -59,7 +60,7 @@ SYMBOL: +mode+ ! Message objects ! ====================================== -TUPLE: participant-changed nick action ; +TUPLE: participant-changed nick action parameter ; C: participant-changed SINGLETON: irc-listener-end ! send to a listener to stop its execution @@ -100,17 +101,21 @@ M: string to-listener ( message string -- ) listener> [ +server-listener+ listener> ] unless* [ to-listener ] [ drop ] if* ; +M: irc-listener to-listener ( message irc-listener -- ) + in-messages>> mailbox-put ; + : unregister-listener ( name -- ) irc> listeners>> [ at [ irc-listener-end ] dip to-listener ] [ delete-at ] 2bi ; -M: irc-listener to-listener ( message irc-listener -- ) - in-messages>> mailbox-put ; +: (remove-participant) ( nick listener -- ) + [ participants>> delete-at ] + [ [ +part+ f ] dip to-listener ] 2bi ; : remove-participant ( nick channel -- ) - listener> [ participants>> delete-at ] [ drop ] if* ; + listener> [ (remove-participant) ] [ drop ] if* ; : listeners-with-participant ( nick -- seq ) irc> listeners>> values @@ -118,10 +123,24 @@ M: irc-listener to-listener ( message irc-listener -- ) with filter ; : remove-participant-from-all ( nick -- ) - dup listeners-with-participant [ participants>> delete-at ] with each ; + dup listeners-with-participant [ (remove-participant) ] with each ; + +: notify-rename ( newnick oldnick listener -- ) + [ participant-changed new +nick+ >>action + [ (>>nick) ] [ (>>parameter) ] [ ] tri ] dip to-listener ; + +: rename-participant ( newnick oldnick listener -- ) + [ participants>> [ delete-at* drop ] [ [ swap ] dip set-at ] bi ] + [ notify-rename ] 3bi ; + +: rename-participant-in-all ( oldnick newnick -- ) + swap dup listeners-with-participant [ rename-participant ] with with each ; : add-participant ( mode nick channel -- ) - listener> [ participants>> set-at ] [ 2drop ] if* ; + listener> [ + [ participants>> set-at ] + [ [ +join+ f ] dip to-listener ] 2bi + ] [ 2drop ] if* ; DEFER: me? @@ -164,25 +183,6 @@ DEFER: me? : broadcast-message-to-listeners ( message -- ) irc> listeners>> values [ to-listener ] with each ; -GENERIC: handle-participant-change ( irc-message -- ) - -M: join handle-participant-change ( join -- ) - [ prefix>> parse-name +join+ ] - [ trailing>> ] bi to-listener ; - -M: part handle-participant-change ( part -- ) - [ prefix>> parse-name +part+ ] - [ channel>> ] bi to-listener ; - -M: kick handle-participant-change ( kick -- ) - [ who>> +part+ ] - [ channel>> ] bi to-listener ; - -M: quit handle-participant-change ( quit -- ) - prefix>> parse-name - [ +part+ ] [ listeners-with-participant ] bi - [ to-listener ] with each ; - GENERIC: handle-incoming-irc ( irc-message -- ) M: irc-message handle-incoming-irc ( irc-message -- ) @@ -201,35 +201,36 @@ M: privmsg handle-incoming-irc ( privmsg -- ) dup irc-message-origin to-listener ; M: join handle-incoming-irc ( join -- ) - { [ maybe-forward-join ] - [ dup trailing>> to-listener ] - [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] - [ handle-participant-change ] - } cleave ; + [ maybe-forward-join ] + [ dup trailing>> to-listener ] + [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ] + tri ; M: part handle-incoming-irc ( part -- ) [ dup channel>> to-listener ] [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ] - [ handle-participant-change ] - tri ; + bi ; M: kick handle-incoming-irc ( kick -- ) - { [ dup channel>> to-listener ] - [ [ who>> ] [ channel>> ] bi remove-participant ] - [ handle-participant-change ] - [ dup who>> me? [ unregister-listener ] [ drop ] if ] - } cleave ; + [ dup channel>> to-listener ] + [ [ who>> ] [ channel>> ] bi remove-participant ] + [ dup who>> me? [ unregister-listener ] [ drop ] if ] + tri ; M: quit handle-incoming-irc ( quit -- ) [ dup prefix>> parse-name listeners-with-participant [ to-listener ] with each ] - [ handle-participant-change ] [ prefix>> parse-name remove-participant-from-all ] - tri ; + bi ; -! FIXME: implement this -! M: mode handle-incoming-irc ( mode -- ) call-next-method ; -! M: nick handle-incoming-irc ( nick -- ) call-next-method ; +M: mode handle-incoming-irc ( mode -- ) ! FIXME: modify participant list + dup channel>> to-listener ; + +M: nick handle-incoming-irc ( nick -- ) + [ dup prefix>> parse-name listeners-with-participant + [ to-listener ] with each ] + [ [ prefix>> parse-name ] [ trailing>> ] bi rename-participant-in-all ] + bi ; : >nick/mode ( string -- nick mode ) dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ; @@ -241,7 +242,7 @@ M: quit handle-incoming-irc ( quit -- ) M: names-reply handle-incoming-irc ( names-reply -- ) [ names-reply>participants ] [ channel>> listener> ] bi [ [ (>>participants) ] - [ [ f f ] dip name>> to-listener ] bi + [ [ f f f ] dip name>> to-listener ] bi ] [ drop ] if* ; M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- ) @@ -367,7 +368,7 @@ M: irc-server-listener (remove-listener) ( irc-server-listener -- ) in-messages>> [ irc-connected ] dip mailbox-put ; : with-irc-client ( irc-client quot: ( -- ) -- ) - [ current-irc-client ] dip with-variable ; inline + [ \ current-irc-client ] dip with-variable ; inline PRIVATE> diff --git a/extra/irc/ui/commands/commands.factor b/extra/irc/ui/commands/commands.factor index 59f4526d23..ddae783f06 100755 --- a/extra/irc/ui/commands/commands.factor +++ b/extra/irc/ui/commands/commands.factor @@ -6,8 +6,15 @@ USING: accessors kernel irc.client irc.messages irc.ui namespaces ; IN: irc.ui.commands : say ( string -- ) - [ client get profile>> nickname>> print-irc ] - [ listener get write-message ] bi ; + irc-tab get + [ window>> client>> profile>> nickname>> print-irc ] + [ listener>> write-message ] 2bi ; + +: join ( string -- ) + irc-tab get window>> join-channel ; + +: query ( string -- ) + irc-tab get window>> query-nick ; : quote ( string -- ) drop ; ! THIS WILL CHANGE diff --git a/extra/irc/ui/ui.factor b/extra/irc/ui/ui.factor index a524168d54..4757e36660 100755 --- a/extra/irc/ui/ui.factor +++ b/extra/irc/ui/ui.factor @@ -19,9 +19,9 @@ SYMBOL: listener SYMBOL: client -TUPLE: ui-window client tabs ; +TUPLE: ui-window < tabbed client ; -TUPLE: irc-tab < frame listener client userlist ; +TUPLE: irc-tab < frame listener client window userlist ; : write-color ( str color -- ) foreground associate format ; @@ -161,44 +161,54 @@ M: object handle-inbox [ swap display ] 2keep ; -TUPLE: irc-editor < editor outstream listener client ; +TUPLE: irc-editor < editor outstream tab ; : ( tab pane -- tab editor ) - over irc-editor new-editor - swap listener>> >>listener swap >>outstream - over client>> >>client ; + irc-editor new-editor + swap >>outstream ; : editor-send ( irc-editor -- ) { [ outstream>> ] - [ listener>> ] - [ client>> ] + [ [ irc-tab? ] find-parent ] [ editor-string ] [ "" swap set-editor-string ] } cleave - '[ , listener set , client set , parse-message ] with-output-stream ; + '[ , irc-tab set , parse-message ] with-output-stream ; irc-editor "general" f { { T{ key-down f f "RET" } editor-send } { T{ key-down f f "ENTER" } editor-send } } define-command-map -: ( listener client -- irc-tab ) - irc-tab new-frame - swap client>> >>client swap >>listener +: new-irc-tab ( listener ui-window class -- irc-tab ) + new-frame + swap >>window + swap >>listener [ @center grid-add ] keep @bottom grid-add ; -: ( listener client -- irc-tab ) - - [ @right grid-add ] keep >>userlist ; - -: ( listener client -- irc-tab ) - ; - M: irc-tab graft* - [ listener>> ] [ client>> ] bi add-listener ; + [ listener>> ] [ window>> client>> ] bi add-listener ; M: irc-tab ungraft* - [ listener>> ] [ client>> ] bi remove-listener ; + [ listener>> ] [ window>> client>> ] bi remove-listener ; + +TUPLE: irc-channel-tab < irc-tab userlist ; + +: ( listener ui-window -- irc-tab ) + irc-tab new-irc-tab + [ @right grid-add ] keep >>userlist ; + +TUPLE: irc-server-tab < irc-tab ; + +: ( listener -- irc-tab ) + f irc-server-tab new-irc-tab ; + +M: irc-server-tab ungraft* + [ window>> client>> terminate-irc ] + [ listener>> ] [ window>> client>> ] tri remove-listener ; + +: ( listener ui-window -- irc-tab ) + irc-tab new-irc-tab ; M: irc-tab pref-dim* drop { 480 480 } ; @@ -206,19 +216,25 @@ M: irc-tab pref-dim* : join-channel ( name ui-window -- ) [ dup ] dip [ swap ] keep - tabs>> add-page ; + add-page ; + +: query-nick ( nick ui-window -- ) + [ dup ] dip + [ swap ] keep + add-page ; : irc-window ( ui-window -- ) - [ tabs>> ] + [ ] [ client>> profile>> server>> ] bi open-window ; : ui-connect ( profile -- ui-window ) - ui-window new over >>client swap - [ connect-irc ] - [ [ ] dip add-listener ] - [ listeners>> +server-listener+ swap at over - "Server" associate >>tabs ] tri ; + + { [ [ ] dip add-listener ] + [ listeners>> +server-listener+ swap at dup + "Server" associate ui-window new-tabbed [ swap (>>window) ] keep ] + [ >>client ] + [ connect-irc ] } cleave ; : server-open ( server port nick password channels -- ) [ ui-connect [ irc-window ] keep ] dip diff --git a/extra/math/combinatorics/combinatorics-tests.factor b/extra/math/combinatorics/combinatorics-tests.factor index e6a2824433..5ef435a4e0 100644 --- a/extra/math/combinatorics/combinatorics-tests.factor +++ b/extra/math/combinatorics/combinatorics-tests.factor @@ -13,11 +13,6 @@ IN: math.combinatorics.tests [ { 0 1 3 2 } ] [ 1 4 permutation-indices ] unit-test [ { 1 2 0 6 3 5 4 } ] [ 859 7 permutation-indices ] unit-test -[ { "b" "d" } ] [ { "a" "b" "c" "d" } { 1 3 } reorder ] unit-test -[ { "a" "b" "c" "d" } ] [ { "a" "b" "c" "d" } { 0 1 2 3 } reorder ] unit-test -[ { "d" "c" "b" "a" } ] [ { "a" "b" "c" "d" } { 3 2 1 0 } reorder ] unit-test -[ { "d" "a" "b" "c" } ] [ { "a" "b" "c" "d" } { 3 0 1 2 } reorder ] unit-test - [ 1 ] [ 0 factorial ] unit-test [ 1 ] [ 1 factorial ] unit-test [ 3628800 ] [ 10 factorial ] unit-test diff --git a/extra/math/combinatorics/combinatorics.factor b/extra/math/combinatorics/combinatorics.factor index f7d7b76fa4..6193edfb91 100644 --- a/extra/math/combinatorics/combinatorics.factor +++ b/extra/math/combinatorics/combinatorics.factor @@ -1,7 +1,7 @@ ! Copyright (c) 2007, 2008 Slava Pestov, Doug Coleman, Aaron Schaefer. ! See http://factorcode.org/license.txt for BSD license. USING: assocs kernel math math.order math.ranges mirrors -namespaces sequences sorting ; +namespaces sequences sequences.lib sorting ; IN: math.combinatorics permutation ; -: reorder ( seq indices -- seq ) - [ [ over nth , ] each drop ] { } make ; - PRIVATE> : factorial ( n -- n! ) @@ -42,7 +39,7 @@ PRIVATE> twiddle [ nPk ] keep factorial / ; : permutation ( n seq -- seq ) - tuck permutation-indices reorder ; + tuck permutation-indices nths ; : all-permutations ( seq -- seq ) [ diff --git a/extra/math/derivatives/authors.txt b/extra/math/derivatives/authors.txt new file mode 100644 index 0000000000..137b1605da --- /dev/null +++ b/extra/math/derivatives/authors.txt @@ -0,0 +1 @@ +Reginald Ford \ No newline at end of file diff --git a/extra/math/function-tools/authors.txt b/extra/math/function-tools/authors.txt new file mode 100644 index 0000000000..137b1605da --- /dev/null +++ b/extra/math/function-tools/authors.txt @@ -0,0 +1 @@ +Reginald Ford \ No newline at end of file diff --git a/extra/math/newtons-method/authors.txt b/extra/math/newtons-method/authors.txt new file mode 100644 index 0000000000..137b1605da --- /dev/null +++ b/extra/math/newtons-method/authors.txt @@ -0,0 +1 @@ +Reginald Ford \ No newline at end of file diff --git a/extra/math/secant-method/authors.txt b/extra/math/secant-method/authors.txt new file mode 100644 index 0000000000..137b1605da --- /dev/null +++ b/extra/math/secant-method/authors.txt @@ -0,0 +1 @@ +Reginald Ford \ No newline at end of file diff --git a/unfinished/compiler/cfg/builder/builder-tests.factor b/unfinished/compiler/cfg/builder/builder-tests.factor new file mode 100644 index 0000000000..098919c868 --- /dev/null +++ b/unfinished/compiler/cfg/builder/builder-tests.factor @@ -0,0 +1,4 @@ +IN: compiler.cfg.builder.tests +USING: compiler.cfg.builder tools.test ; + +\ build-cfg must-infer diff --git a/unfinished/compiler/cfg/builder/builder.factor b/unfinished/compiler/cfg/builder/builder.factor index 2f68864e81..76a1b67dd2 100644 --- a/unfinished/compiler/cfg/builder/builder.factor +++ b/unfinished/compiler/cfg/builder/builder.factor @@ -1,29 +1,33 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel assocs sequences sequences.lib fry accessors -compiler.cfg compiler.vops compiler.vops.builder -namespaces math inference.dataflow optimizer.allot combinators -math.order ; +namespaces math combinators math.order +compiler.tree +compiler.tree.combinators +compiler.tree.propagation.info +compiler.cfg +compiler.vops +compiler.vops.builder ; IN: compiler.cfg.builder -! Convert dataflow IR to procedure CFG. +! Convert tree SSA IR to CFG SSA IR. + ! We construct the graph and set successors first, then we ! set predecessors in a separate pass. This simplifies the ! logic. SYMBOL: procedures -SYMBOL: values>vregs - SYMBOL: loop-nesting -GENERIC: convert* ( node -- ) +SYMBOL: values>vregs GENERIC: convert ( node -- ) +M: #introduce convert drop ; + : init-builder ( -- ) - H{ } clone values>vregs set - V{ } clone loop-nesting set ; + H{ } clone values>vregs set ; : end-basic-block ( -- ) basic-block get [ %b emit ] when ; @@ -40,15 +44,12 @@ GENERIC: convert ( node -- ) set-basic-block ; : convert-nodes ( node -- ) - dup basic-block get and [ - [ convert ] [ successor>> convert-nodes ] bi - ] [ drop ] if ; + [ convert ] each ; : (build-cfg) ( node word -- ) init-builder begin-basic-block basic-block get swap procedures get set-at - %prolog emit convert-nodes ; : build-cfg ( node word -- procedures ) @@ -73,10 +74,9 @@ GENERIC: convert ( node -- ) 2bi ] if ; -: load-inputs ( node -- ) - [ in-d>> %data (load-inputs) ] - [ in-r>> %retain (load-inputs) ] - bi ; +: load-in-d ( node -- ) in-d>> %data (load-inputs) ; + +: load-in-r ( node -- ) in-r>> %retain (load-inputs) ; : (store-outputs) ( seq stack -- ) over empty? [ 2drop ] [ @@ -86,40 +86,21 @@ GENERIC: convert ( node -- ) 2bi ] if ; -: store-outputs ( node -- ) - [ out-d>> %data (store-outputs) ] - [ out-r>> %retain (store-outputs) ] - bi ; +: store-out-d ( node -- ) out-d>> %data (store-outputs) ; -M: #push convert* - out-d>> [ - [ produce-vreg ] [ value-literal ] bi - emit-literal - ] each ; - -M: #shuffle convert* drop ; - -M: #>r convert* drop ; - -M: #r> convert* drop ; - -M: node convert - [ load-inputs ] - [ convert* ] - [ store-outputs ] - tri ; +: store-out-r ( node -- ) out-r>> %retain (store-outputs) ; : (emit-call) ( word -- ) begin-basic-block %call emit begin-basic-block ; : intrinsic-inputs ( node -- ) - [ load-inputs ] + [ load-in-d ] [ in-d>> { #1 #2 #3 #4 } [ [ value>vreg ] dip set ] 2each ] bi ; : intrinsic-outputs ( node -- ) [ out-d>> { ^1 ^2 ^3 ^4 } [ get output-vreg ] 2each ] - [ store-outputs ] + [ store-out-d ] bi ; : intrinsic ( node quot -- ) @@ -132,19 +113,17 @@ M: node convert tri ] with-scope ; inline -USING: kernel.private math.private slots.private -optimizer.allot ; +USING: kernel.private math.private slots.private ; : maybe-emit-fixnum-shift-fast ( node -- node ) - dup dup in-d>> second node-literal? [ - dup dup in-d>> second node-literal + dup dup in-d>> second node-value-info literal>> dup fixnum? [ '[ , emit-fixnum-shift-fast ] intrinsic ] [ - dup param>> (emit-call) + drop dup word>> (emit-call) ] if ; : emit-call ( node -- ) - dup param>> { + dup word>> { { \ tag [ [ emit-tag ] intrinsic ] } { \ slot [ [ dup emit-slot ] intrinsic ] } @@ -175,24 +154,43 @@ optimizer.allot ; { \ float> [ [ emit-float> ] intrinsic ] } { \ float? [ [ emit-float= ] intrinsic ] } - { \ (tuple) [ dup first-input '[ , emit-(tuple) ] intrinsic ] } - { \ (array) [ dup first-input '[ , emit-(array) ] intrinsic ] } - { \ (byte-array) [ dup first-input '[ , emit-(byte-array) ] intrinsic ] } + ! { \ (tuple) [ dup first-input '[ , emit-(tuple) ] intrinsic ] } + ! { \ (array) [ dup first-input '[ , emit-(array) ] intrinsic ] } + ! { \ (byte-array) [ dup first-input '[ , emit-(byte-array) ] intrinsic ] } [ (emit-call) ] } case drop ; M: #call convert emit-call ; -M: #call-label convert - dup param>> loop-nesting get at [ - basic-block get successors>> push - end-basic-block - basic-block off - drop - ] [ - (emit-call) - ] if* ; +: emit-call-loop ( #recursive -- ) + dup label>> loop-nesting get at basic-block get successors>> push + end-basic-block + basic-block off + drop ; + +: emit-call-recursive ( #recursive -- ) + label>> id>> (emit-call) ; + +M: #call-recursive convert + dup label>> loop?>> + [ emit-call-loop ] [ emit-call-recursive ] if ; + +M: #push convert + [ + [ out-d>> first produce-vreg ] + [ node-output-infos first literal>> ] + bi emit-literal + ] + [ store-out-d ] bi ; + +M: #shuffle convert [ load-in-d ] [ store-out-d ] bi ; + +M: #>r convert [ load-in-d ] [ store-out-r ] bi ; + +M: #r> convert [ load-in-r ] [ store-out-d ] bi ; + +M: #terminate convert drop ; : integer-conditional ( in1 in2 cc -- ) [ [ next-vreg dup ] 2dip %icmp emit ] dip %bi emit ; inline @@ -221,50 +219,38 @@ M: #call-label convert [ set-basic-block ] bi ; -: phi-inputs ( #if -- vregs-seq ) - children>> - [ last-node ] map - [ #values? ] filter - [ in-d>> [ value>vreg ] map ] map ; - -: phi-outputs ( #if -- vregs ) - successor>> out-d>> [ produce-vreg ] map ; - -: emit-phi ( #if -- ) - [ phi-outputs ] [ phi-inputs ] bi %phi emit ; - M: #if convert - { - [ load-inputs ] - [ emit-if ] - [ convert-if-children ] - [ emit-phi ] - } cleave ; + [ load-in-d ] [ emit-if ] [ convert-if-children ] tri ; -M: #values convert drop ; +M: #dispatch convert + "Unimplemented" throw ; -M: #merge convert drop ; - -M: #entry convert drop ; +M: #phi convert drop ; M: #declare convert drop ; -M: #terminate convert drop ; +M: #return convert drop %return emit ; -M: #label convert - #! Labels create a new procedure. - [ [ param>> ] [ node-child ] bi (build-cfg) ] [ (emit-call) ] bi ; +: convert-recursive ( #recursive -- ) + [ [ label>> id>> ] [ child>> ] bi (build-cfg) ] + [ (emit-call) ] + bi ; -M: #loop convert - #! Loops become part of the current CFG. - begin-basic-block - [ param>> basic-block get 2array loop-nesting get push ] - [ node-child convert-nodes ] - bi +: begin-loop ( #recursive -- ) + label>> basic-block get 2array loop-nesting get push ; + +: end-loop ( -- ) loop-nesting get pop* ; -M: #return convert - param>> loop-nesting get key? [ - %epilog emit - %return emit - ] unless ; +: convert-loop ( #recursive -- ) + begin-basic-block + [ begin-loop ] + [ child>> convert-nodes ] + [ drop end-loop ] + tri ; + +M: #recursive convert + dup label>> loop?>> + [ convert-loop ] [ convert-recursive ] if ; + +M: #copy convert drop ; diff --git a/unfinished/compiler/generator/authors.txt b/unfinished/compiler/generator/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/unfinished/compiler/generator/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/unfinished/compiler/generator/fixup/authors.txt b/unfinished/compiler/generator/fixup/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/unfinished/compiler/generator/fixup/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/unfinished/compiler/generator/fixup/fixup-docs.factor b/unfinished/compiler/generator/fixup/fixup-docs.factor new file mode 100644 index 0000000000..a4ff549e8e --- /dev/null +++ b/unfinished/compiler/generator/fixup/fixup-docs.factor @@ -0,0 +1,16 @@ +USING: help.syntax help.markup math kernel +words strings alien ; +IN: compiler.generator.fixup + +HELP: frame-required +{ $values { "n" "a non-negative integer" } } +{ $description "Notify the code generator that the currently compiling code block needs a stack frame with room for at least " { $snippet "n" } " parameters." } ; + +HELP: add-literal +{ $values { "obj" object } { "n" integer } } +{ $description "Adds a literal to the " { $link literal-table } ", if it is not already there, and outputs the index of the literal in the table. This literal can then be used as an argument for a " { $link rt-literal } " relocation with " { $link rel-fixup } "." } ; + +HELP: rel-dlsym +{ $values { "name" string } { "dll" "a " { $link dll } " or " { $link f } } { "class" "a relocation class" } } +{ $description "Records that the most recently assembled instruction contains a reference to the " { $snippet "name" } " symbol from " { $snippet "dll" } ". The correct " { $snippet "class" } " to use depends on instruction formats." +} ; diff --git a/unfinished/compiler/generator/fixup/fixup.factor b/unfinished/compiler/generator/fixup/fixup.factor new file mode 100755 index 0000000000..e1b4e42e67 --- /dev/null +++ b/unfinished/compiler/generator/fixup/fixup.factor @@ -0,0 +1,154 @@ +! Copyright (C) 2007, 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays byte-arrays generic assocs hashtables io.binary +kernel kernel.private math namespaces sequences words +quotations strings alien.accessors alien.strings layouts system +combinators math.bitfields words.private cpu.architecture +math.order accessors growable ; +IN: compiler.generator.fixup + +: no-stack-frame -1 ; inline + +TUPLE: frame-required n ; + +: frame-required ( n -- ) \ frame-required boa , ; + +: stack-frame-size ( code -- n ) + no-stack-frame [ + dup frame-required? [ frame-required-n max ] [ drop ] if + ] reduce ; + +GENERIC: fixup* ( frame-size obj -- frame-size ) + +: code-format 22 getenv ; + +: compiled-offset ( -- n ) building get length code-format * ; + +TUPLE: label offset ; + +: