diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor index ac1895e37e..60bbbcd259 100755 --- a/core/alien/compiler/compiler.factor +++ b/core/alien/compiler/compiler.factor @@ -7,7 +7,7 @@ math.parser classes alien.arrays alien.c-types alien.strings alien.structs alien.syntax cpu.architecture alien inspector quotations assocs kernel.private threads continuations.private libc combinators compiler.errors continuations layouts accessors -init ; +init sets ; IN: alien.compiler TUPLE: #alien-node < node return parameters abi ; @@ -339,7 +339,7 @@ SYMBOL: callbacks [ H{ } clone callbacks set-global ] "alien.compiler" add-init-hook -: register-callback ( word -- ) dup callbacks get set-at ; +: register-callback ( word -- ) callbacks get conjoin ; M: alien-callback-error summary drop "Words calling ``alien-callback'' must be compiled with the optimizing compiler." ; diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index b33773cf9e..0e1042391c 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -79,7 +79,6 @@ ARTICLE: "assocs-sets" "Set-theoretic operations on assocs" ARTICLE: "assocs-mutation" "Storing keys and values in assocs" "Utility operations built up from the " { $link "assocs-protocol" } ":" { $subsection delete-at* } -{ $subsection delete-any } { $subsection rename-at } { $subsection change-at } { $subsection at+ } @@ -242,12 +241,6 @@ HELP: delete-at* { $description "Removes an entry from the assoc and outputs the previous value together with a boolean indicating whether it was present." } { $side-effects "assoc" } ; -HELP: delete-any -{ $values { "assoc" assoc } { "key" "a key" } { "value" "a value" } } -{ $description "Removes an undetermined entry from the assoc and outputs it." } -{ $errors "Throws an error if the assoc is empty." } -{ $notes "This word is useful when using an assoc as an unordered queue which requires constant-time membership tests. Entries are enqueued with " { $link set-at } " and dequeued with " { $link delete-any } "." } ; - HELP: rename-at { $values { "newkey" object } { "key" object } { "assoc" assoc } } { $description "Removes the values associated to " { $snippet "key" } " and re-adds it as " { $snippet "newkey" } ". Does nothing if the assoc does not contain " { $snippet "key" } "." } diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 15afce3e93..ca49b550b0 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -76,12 +76,6 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : rename-at ( newkey key assoc -- ) tuck delete-at* [ -rot set-at ] [ 3drop ] if ; -: delete-any ( assoc -- key value ) - [ - [ 2drop t ] assoc-find - [ "Assoc is empty" throw ] unless over - ] keep delete-at ; - : assoc-empty? ( assoc -- ? ) assoc-size zero? ; diff --git a/core/classes/classes.factor b/core/classes/classes.factor index 593213c5c6..096c620c28 100755 --- a/core/classes/classes.factor +++ b/core/classes/classes.factor @@ -99,8 +99,8 @@ M: word reset-class drop ; : (define-class) ( word props -- ) >r - dup reset-class dup class? [ dup new-class ] unless + dup reset-class dup deferred? [ dup define-symbol ] when dup word-props r> assoc-union over set-word-props diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor index 9ffcd952e3..e70e649805 100755 --- a/core/classes/mixin/mixin.factor +++ b/core/classes/mixin/mixin.factor @@ -51,8 +51,12 @@ TUPLE: check-mixin-class mixin ; #! updated by transitivity; the mixins usages appear in #! class-usages of the member, now that it's been added. [ 2drop ] [ - [ [ suffix ] change-mixin-class ] 2keep drop - dup new-class? [ update-classes/new ] [ update-classes ] if + [ [ suffix ] change-mixin-class ] 2keep + tuck [ new-class? ] either? [ + update-classes/new + ] [ + update-classes + ] if ] if-mixin-member? ; : remove-mixin-instance ( class mixin -- ) diff --git a/core/compiler/compiler.factor b/core/compiler/compiler.factor index 8c653b866e..4ee2fd5cdf 100755 --- a/core/compiler/compiler.factor +++ b/core/compiler/compiler.factor @@ -4,20 +4,25 @@ USING: kernel namespaces arrays sequences io inference.backend inference.state generator debugger words compiler.units continuations vocabs assocs alien.compiler dlists optimizer definitions math compiler.errors threads graphs generic -inference combinators ; +inference combinators dequeues search-dequeues ; IN: compiler -: ripple-up ( word -- ) - compiled-usage [ drop queue-compile ] assoc-each ; +SYMBOL: +failed+ + +: ripple-up ( words -- ) + dup "compiled-effect" word-prop +failed+ eq? + [ usage [ word? ] filter ] [ compiled-usage keys ] if + [ queue-compile ] each ; + +: ripple-up? ( word effect -- ? ) + #! If the word has previously been compiled and had a + #! different stack effect, we have to recompile any callers. + swap "compiled-effect" word-prop [ = not ] keep and ; : save-effect ( word effect -- ) - [ - over "compiled-effect" word-prop = [ - dup "compiled-uses" word-prop - [ dup ripple-up ] when - ] unless drop - ] - [ "compiled-effect" set-word-prop ] 2bi ; + [ dupd ripple-up? [ ripple-up ] [ drop ] if ] + [ "compiled-effect" set-word-prop ] + 2bi ; : compile-begins ( word -- ) f swap compiler-error ; @@ -26,9 +31,10 @@ IN: compiler [ swap compiler-error ] [ drop + [ compiled-unxref ] [ f swap compiled get set-at ] - [ f save-effect ] - bi + [ +failed+ save-effect ] + tri ] 2bi ; : compile-succeeded ( effect word -- ) @@ -40,6 +46,7 @@ IN: compiler ] tri ; : (compile) ( word -- ) + dup dup "compile-count" word-prop 0 or 1 + "compile-count" set-word-prop [ H{ } clone dependencies set @@ -54,19 +61,15 @@ IN: compiler } cleave ] curry with-return ; -: compile-loop ( assoc -- ) - dup assoc-empty? [ drop ] [ - dup delete-any drop (compile) - yield - compile-loop - ] if ; +: compile-loop ( dequeue -- ) + [ (compile) yield ] slurp-dequeue ; : decompile ( word -- ) f 2array 1array t modify-code-heap ; : optimized-recompile-hook ( words -- alist ) [ - H{ } clone compile-queue set + compile-queue set H{ } clone compiled set [ queue-compile ] each compile-queue get compile-loop diff --git a/core/compiler/tests/insane.factor b/core/compiler/tests/insane.factor new file mode 100644 index 0000000000..79e17f7343 --- /dev/null +++ b/core/compiler/tests/insane.factor @@ -0,0 +1,4 @@ +IN: compiler.tests +USING: words kernel inference alien.strings tools.test ; + +[ ] [ \ if redefined [ string>alien ] infer. ] unit-test diff --git a/core/compiler/tests/redefine.factor b/core/compiler/tests/redefine.factor deleted file mode 100644 index b87898c649..0000000000 --- a/core/compiler/tests/redefine.factor +++ /dev/null @@ -1,14 +0,0 @@ -IN: compiler.tests -USING: compiler tools.test math parser ; - -GENERIC: method-redefine-test ( a -- b ) - -M: integer method-redefine-test 3 + ; - -: method-redefine-test-1 ( -- b ) 3 method-redefine-test ; - -[ 6 ] [ method-redefine-test-1 ] unit-test - -[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-test 4 + ;" eval ] unit-test - -[ 7 ] [ method-redefine-test-1 ] unit-test diff --git a/core/compiler/tests/redefine1.factor b/core/compiler/tests/redefine1.factor new file mode 100644 index 0000000000..b7abacc6e4 --- /dev/null +++ b/core/compiler/tests/redefine1.factor @@ -0,0 +1,67 @@ +IN: compiler.tests +USING: compiler compiler.units tools.test math parser kernel +sequences sequences.private classes.mixin generic definitions +arrays words assocs ; + +GENERIC: method-redefine-test ( a -- b ) + +M: integer method-redefine-test 3 + ; + +: method-redefine-test-1 ( -- b ) 3 method-redefine-test ; + +[ 6 ] [ method-redefine-test-1 ] unit-test + +[ ] [ "IN: compiler.tests USE: math M: fixnum method-redefine-test 4 + ;" eval ] unit-test + +[ 7 ] [ method-redefine-test-1 ] unit-test + +[ ] [ [ fixnum \ method-redefine-test method forget ] with-compilation-unit ] unit-test + +[ 6 ] [ method-redefine-test-1 ] unit-test + +! Test ripple-up behavior +: hey ( -- ) ; +: there ( -- ) hey ; + +[ t ] [ \ hey compiled? ] unit-test +[ t ] [ \ there compiled? ] unit-test +[ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test +[ f ] [ \ hey compiled? ] unit-test +[ f ] [ \ there compiled? ] unit-test +[ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test +[ t ] [ \ there compiled? ] unit-test + +! Just changing the stack effect didn't mark a word for recompilation +DEFER: change-effect + +[ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- b )" eval ] unit-test +{ 1 1 } [ change-effect ] must-infer-as + +[ ] [ "IN: compiler.tests GENERIC: change-effect ( a -- )" eval ] unit-test +{ 1 0 } [ change-effect ] must-infer-as + +: good ( -- ) ; +: bad ( -- ) good ; +: ugly ( -- ) bad ; + +[ t ] [ \ good compiled? ] unit-test +[ t ] [ \ bad compiled? ] unit-test +[ t ] [ \ ugly compiled? ] unit-test + +[ f ] [ \ good compiled-usage assoc-empty? ] unit-test + +[ ] [ "IN: compiler.tests : good ( -- ) 3 ;" eval ] unit-test + +[ f ] [ \ good compiled? ] unit-test +[ f ] [ \ bad compiled? ] unit-test +[ f ] [ \ ugly compiled? ] unit-test + +[ t ] [ \ good compiled-usage assoc-empty? ] unit-test + +[ ] [ "IN: compiler.tests : good ( -- ) ;" eval ] unit-test + +[ t ] [ \ good compiled? ] unit-test +[ t ] [ \ bad compiled? ] unit-test +[ t ] [ \ ugly compiled? ] unit-test + +[ f ] [ \ good compiled-usage assoc-empty? ] unit-test diff --git a/core/compiler/tests/redefine2.factor b/core/compiler/tests/redefine2.factor new file mode 100644 index 0000000000..107381c4d3 --- /dev/null +++ b/core/compiler/tests/redefine2.factor @@ -0,0 +1,18 @@ +IN: compiler.tests +USING: compiler compiler.units tools.test math parser kernel +sequences sequences.private classes.mixin generic definitions +arrays words assocs ; + +DEFER: blah + +[ ] [ "USE: sequences USE: kernel IN: compiler.tests TUPLE: blah ; M: blah nth 2drop 3 ; INSTANCE: blah sequence" eval ] unit-test + +[ t ] [ blah new sequence? ] unit-test + +[ 3 ] [ 0 blah new nth-unsafe ] unit-test + +[ ] [ [ blah sequence remove-mixin-instance ] with-compilation-unit ] unit-test + +[ f ] [ blah new sequence? ] unit-test + +[ 0 blah new nth-unsafe ] must-fail diff --git a/core/compiler/tests/redefine3.factor b/core/compiler/tests/redefine3.factor new file mode 100644 index 0000000000..2b27b64b61 --- /dev/null +++ b/core/compiler/tests/redefine3.factor @@ -0,0 +1,32 @@ +IN: compiler.tests +USING: compiler compiler.units tools.test math parser kernel +sequences sequences.private classes.mixin generic definitions +arrays words assocs ; + +GENERIC: sheeple ( obj -- x ) + +M: object sheeple drop "sheeple" ; + +MIXIN: empty-mixin + +M: empty-mixin sheeple drop "wake up" ; + +: sheeple-test ( -- string ) { } sheeple ; + +[ "sheeple" ] [ sheeple-test ] unit-test +[ t ] [ \ sheeple-test compiled? ] unit-test +[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test +[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test + +[ ] [ "IN: compiler.tests USE: arrays INSTANCE: array empty-mixin" eval ] unit-test + +[ "wake up" ] [ sheeple-test ] unit-test +[ f ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test +[ t ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test + +[ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test + +[ "sheeple" ] [ sheeple-test ] unit-test +[ t ] [ \ sheeple-test compiled? ] unit-test +[ t ] [ object \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test +[ f ] [ empty-mixin \ sheeple method \ sheeple-test "compiled-uses" word-prop key? ] unit-test diff --git a/core/compiler/tests/reload.factor b/core/compiler/tests/reload.factor new file mode 100644 index 0000000000..1e31757fca --- /dev/null +++ b/core/compiler/tests/reload.factor @@ -0,0 +1,6 @@ +IN: compiler.tests +USE: vocabs.loader + +"parser" reload +"sequences" reload +"kernel" reload diff --git a/core/compiler/units/units.factor b/core/compiler/units/units.factor index 658a64315e..b0c4948956 100755 --- a/core/compiler/units/units.factor +++ b/core/compiler/units/units.factor @@ -79,9 +79,15 @@ SYMBOL: update-tuples-hook : call-update-tuples-hook ( -- ) update-tuples-hook get call ; +: unxref-forgotten-definitions ( -- ) + forgotten-definitions get + keys [ word? ] filter + [ delete-compiled-xref ] each ; + : finish-compilation-unit ( -- ) call-recompile-hook call-update-tuples-hook + unxref-forgotten-definitions dup [ drop crossref? ] assoc-contains? modify-code-heap ; : with-nested-compilation-unit ( quot -- ) diff --git a/core/generator/generator.factor b/core/generator/generator.factor index 684c058913..7e64935e07 100755 --- a/core/generator/generator.factor +++ b/core/generator/generator.factor @@ -1,11 +1,11 @@ -! Copyright (C) 2004, 2008 Slava Pestov. + ! Copyright (C) 2004, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs classes combinators cpu.architecture effects generator.fixup generator.registers generic hashtables inference inference.backend inference.dataflow io kernel kernel.private layouts math namespaces optimizer optimizer.specializers prettyprint quotations sequences system -threads words vectors ; +threads words vectors sets dequeues ; IN: generator SYMBOL: compile-queue @@ -16,7 +16,7 @@ SYMBOL: compiled { [ dup compiled get key? ] [ drop ] } { [ dup inlined-block? ] [ drop ] } { [ dup primitive? ] [ drop ] } - [ dup compile-queue get set-at ] + [ compile-queue get push-front ] } cond ; : maybe-compile ( word -- ) diff --git a/core/generic/generic.factor b/core/generic/generic.factor index fb9820008a..965c9d8ad8 100755 --- a/core/generic/generic.factor +++ b/core/generic/generic.factor @@ -58,18 +58,17 @@ TUPLE: check-method class generic ; : affected-methods ( class generic -- seq ) "methods" word-prop swap - [ nip classes-intersect? ] curry assoc-filter + [ nip [ classes-intersect? ] [ class<= ] 2bi or ] curry assoc-filter values ; : update-generic ( class generic -- ) - [ affected-methods [ +called+ changed-definition ] each ] - [ make-generic ] - bi ; + affected-methods [ +called+ changed-definition ] each ; : with-methods ( class generic quot -- ) + [ drop update-generic ] [ [ "methods" word-prop ] dip call ] - [ drop update-generic ] 3bi ; - inline + [ drop make-generic drop ] + 3tri ; inline : method-word-name ( class word -- string ) word-name "/" rot word-name 3append ; @@ -81,7 +80,7 @@ M: method-body stack-effect "method-generic" word-prop stack-effect ; M: method-body crossref? - drop t ; + "forgotten" word-prop not ; : method-word-props ( class generic -- assoc ) [ @@ -106,8 +105,8 @@ M: method-body crossref? ] if ; : ( generic combination -- method ) - object bootstrap-word pick - [ -rot make-default-method define ] keep ; + [ drop object bootstrap-word swap ] [ make-default-method ] 2bi + [ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ; : define-default-method ( generic combination -- ) dupd "default-method" set-word-prop ; @@ -137,13 +136,15 @@ M: method-body definer M: method-body forget* dup "forgotten" word-prop [ drop ] [ [ - [ ] - [ "method-class" word-prop ] - [ "method-generic" word-prop ] tri - 3dup method eq? [ - [ delete-at ] with-methods - call-next-method - ] [ 3drop ] if + dup "default" word-prop [ call-next-method ] [ + dup + [ "method-class" word-prop ] + [ "method-generic" word-prop ] bi + 3dup method eq? [ + [ delete-at ] with-methods + call-next-method + ] [ 3drop ] if + ] if ] [ t "forgotten" set-word-prop ] bi ] if ; @@ -178,7 +179,10 @@ M: class forget* ( class -- ) [ call-next-method ] bi ; M: assoc update-methods ( class assoc -- ) - implementors [ update-generic ] with each ; + implementors [ + [ update-generic ] + [ make-generic drop ] 2bi + ] with each ; : define-generic ( word combination -- ) over "combination" word-prop over = [ diff --git a/core/generic/standard/engines/tuple/tuple.factor b/core/generic/standard/engines/tuple/tuple.factor index 9a780383b5..2654490d88 100644 --- a/core/generic/standard/engines/tuple/tuple.factor +++ b/core/generic/standard/engines/tuple/tuple.factor @@ -64,7 +64,7 @@ M: engine-word stack-effect [ extra-values ] [ stack-effect ] bi dup [ clone [ length + ] change-in ] [ 2drop f ] if ; -M: engine-word crossref? drop t ; +M: engine-word crossref? "forgotten" word-prop not ; M: engine-word irrelevant? drop t ; diff --git a/core/graphs/graphs.factor b/core/graphs/graphs.factor index 973d49f1fa..792b2ab340 100644 --- a/core/graphs/graphs.factor +++ b/core/graphs/graphs.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2006, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs kernel namespaces sequences ; +USING: assocs kernel namespaces sequences sets ; IN: graphs SYMBOL: graph @@ -41,7 +41,7 @@ SYMBOL: previous over previous get key? [ 2drop ] [ - over dup previous get set-at + over previous get conjoin dup slip [ nip (closure) ] curry assoc-each ] if ; inline diff --git a/core/inference/backend/backend.factor b/core/inference/backend/backend.factor index 080e77af02..de5ca6d5e6 100755 --- a/core/inference/backend/backend.factor +++ b/core/inference/backend/backend.factor @@ -4,7 +4,8 @@ USING: inference.dataflow inference.state arrays generic io io.streams.string kernel math namespaces parser prettyprint sequences strings vectors words quotations effects classes continuations debugger assocs combinators compiler.errors -generic.standard.engines.tuple accessors math.order definitions ; +generic.standard.engines.tuple accessors math.order definitions +sets ; IN: inference.backend : recursive-label ( word -- label/f ) @@ -28,7 +29,7 @@ SYMBOL: visited : (redefined) ( word -- ) dup visited get key? [ drop ] [ [ reset-on-redefine reset-props ] - [ dup visited get set-at ] + [ visited get conjoin ] [ crossref get at keys [ word? ] filter diff --git a/core/inference/inference-tests.factor b/core/inference/inference-tests.factor index 7f073bfad9..c9c3f1de6b 100755 --- a/core/inference/inference-tests.factor +++ b/core/inference/inference-tests.factor @@ -546,26 +546,26 @@ ERROR: custom-error ; [ [ erg's-inference-bug ] infer ] must-fail -! : inference-invalidation-a ( -- ); -! : inference-invalidation-b ( quot -- ) [ inference-invalidation-a ] dip call ; inline -! : inference-invalidation-c ( a b -- c ) [ + ] inference-invalidation-b ; -! -! [ 7 ] [ 4 3 inference-invalidation-c ] unit-test -! -! { 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as -! -! [ ] [ "IN: inference.tests : inference-invalidation-a 1 2 ;" eval ] unit-test -! -! [ 3 ] [ inference-invalidation-c ] unit-test -! -! { 0 1 } [ inference-invalidation-c ] must-infer-as -! -! GENERIC: inference-invalidation-d ( obj -- ) -! -! M: object inference-invalidation-d inference-invalidation-c 2drop ; -! -! \ inference-invalidation-d must-infer -! -! [ ] [ "IN: inference.tests : inference-invalidation-a ;" eval ] unit-test -! -! [ [ inference-invalidation-d ] infer ] must-fail +: inference-invalidation-a ( -- ) ; +: inference-invalidation-b ( quot -- ) [ inference-invalidation-a ] dip call ; inline +: inference-invalidation-c ( a b -- c ) [ + ] inference-invalidation-b ; inline + +[ 7 ] [ 4 3 inference-invalidation-c ] unit-test + +{ 2 1 } [ [ + ] inference-invalidation-b ] must-infer-as + +[ ] [ "IN: inference.tests : inference-invalidation-a ( -- a b ) 1 2 ;" eval ] unit-test + +[ 3 ] [ inference-invalidation-c ] unit-test + +{ 0 1 } [ inference-invalidation-c ] must-infer-as + +GENERIC: inference-invalidation-d ( obj -- ) + +M: object inference-invalidation-d inference-invalidation-c 2drop ; + +\ inference-invalidation-d must-infer + +[ ] [ "IN: inference.tests : inference-invalidation-a ( -- ) ;" eval ] unit-test + +[ [ inference-invalidation-d ] infer ] must-fail diff --git a/core/inference/inference.factor b/core/inference/inference.factor index d73e43cdfc..da9e6ff10d 100755 --- a/core/inference/inference.factor +++ b/core/inference/inference.factor @@ -9,19 +9,22 @@ IN: inference GENERIC: infer ( quot -- effect ) M: callable infer ( quot -- effect ) - [ f infer-quot ] with-infer drop ; + [ recursive-state get infer-quot ] with-infer drop ; : infer. ( quot -- ) + #! Safe to call from inference transforms. infer effect>string print ; GENERIC: dataflow ( quot -- dataflow ) M: callable dataflow + #! Not safe to call from inference transforms. [ f infer-quot ] with-infer nip ; GENERIC# dataflow-with 1 ( quot stack -- dataflow ) M: callable dataflow-with + #! Not safe to call from inference transforms. [ V{ } like meta-d set f infer-quot diff --git a/core/libc/libc.factor b/core/libc/libc.factor index dff6e9e0f1..cda5260397 100755 --- a/core/libc/libc.factor +++ b/core/libc/libc.factor @@ -3,7 +3,7 @@ ! Copyright (C) 2007, 2008 Doug Coleman ! See http://factorcode.org/license.txt for BSD license. USING: alien assocs continuations destructors init kernel -namespaces accessors ; +namespaces accessors sets ; IN: libc ( -- pprinter ) 0 1 0 pprinter boa ; : record-vocab ( word -- ) - word-vocabulary [ dup pprinter-use get set-at ] when* ; + word-vocabulary [ pprinter-use get conjoin ] when* ; ! Utility words : line-limit? ( -- ? ) diff --git a/core/search-dequeues/authors.txt b/core/search-dequeues/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/core/search-dequeues/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/core/search-dequeues/search-dequeues-docs.factor b/core/search-dequeues/search-dequeues-docs.factor index fb3309543a..de9e9f0084 100644 --- a/core/search-dequeues/search-dequeues-docs.factor +++ b/core/search-dequeues/search-dequeues-docs.factor @@ -10,6 +10,8 @@ $nl "Default implementation:" { $subsection } ; +ABOUT: "search-dequeues" + HELP: ( assoc dequeue -- search-dequeue ) { $values { "assoc" assoc } { "dequeue" dequeue } { "search-dequeue" search-dequeue } } { $description "Creates a new " { $link search-dequeue } "." } ; diff --git a/core/search-dequeues/summary.txt b/core/search-dequeues/summary.txt new file mode 100644 index 0000000000..9102bf2d58 --- /dev/null +++ b/core/search-dequeues/summary.txt @@ -0,0 +1 @@ +Double-ended queues with sub-linear membership testing diff --git a/core/search-dequeues/tags.txt b/core/search-dequeues/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/core/search-dequeues/tags.txt @@ -0,0 +1 @@ +collections diff --git a/core/sequences/sequences-tests.factor b/core/sequences/sequences-tests.factor index 81384a40c4..60c75a8920 100755 --- a/core/sequences/sequences-tests.factor +++ b/core/sequences/sequences-tests.factor @@ -243,6 +243,3 @@ unit-test [ "asdf" ] [ " asdf " [ CHAR: \s = ] trim ] unit-test [ "asdf " ] [ " asdf " [ CHAR: \s = ] left-trim ] unit-test [ " asdf" ] [ " asdf " [ CHAR: \s = ] right-trim ] unit-test - -! Hardcore -[ ] [ "sequences" reload ] unit-test diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor index a0d601e2ad..6361ddad61 100755 --- a/core/syntax/syntax.factor +++ b/core/syntax/syntax.factor @@ -182,8 +182,14 @@ IN: bootstrap.syntax ] define-syntax "(" [ - ")" parse-effect word - [ swap "declared-effect" set-word-prop ] [ drop ] if* + ")" parse-effect + word dup [ + swap + [ "declared-effect" set-word-prop ] + [ drop redefined ] + [ drop +inlined+ changed-definition ] + 2tri + ] [ 2drop ] if ] define-syntax "((" [ diff --git a/core/threads/threads-docs.factor b/core/threads/threads-docs.factor index 7d8791d493..944526e05c 100755 --- a/core/threads/threads-docs.factor +++ b/core/threads/threads-docs.factor @@ -1,6 +1,6 @@ USING: help.markup help.syntax kernel kernel.private io threads.private continuations dlists init quotations strings -assocs heaps boxes namespaces ; +assocs heaps boxes namespaces dequeues ; IN: threads ARTICLE: "threads-start/stop" "Starting and stopping threads" diff --git a/core/threads/threads.factor b/core/threads/threads.factor index c23ced42b9..4fe4c5bcb2 100755 --- a/core/threads/threads.factor +++ b/core/threads/threads.factor @@ -4,7 +4,7 @@ USING: arrays hashtables heaps kernel kernel.private math namespaces sequences vectors continuations continuations.private dlists assocs system combinators init boxes accessors -math.order ; +math.order dequeues ; IN: threads SYMBOL: initial-thread @@ -86,7 +86,7 @@ PRIVATE> : sleep-time ( -- ms/f ) { - { [ run-queue dlist-empty? not ] [ 0 ] } + { [ run-queue dequeue-empty? not ] [ 0 ] } { [ sleep-queue heap-empty? ] [ f ] } [ sleep-queue heap-peek nip millis [-] ] } cond ; @@ -146,7 +146,7 @@ DEFER: next : next ( -- * ) expire-sleep-loop - run-queue dup dlist-empty? [ + run-queue dup dequeue-empty? [ drop no-runnable-threads ] [ pop-back dup array? [ first2 ] [ f swap ] if (next) diff --git a/core/words/words-tests.factor b/core/words/words-tests.factor index 2a164ab11d..13be1adb69 100755 --- a/core/words/words-tests.factor +++ b/core/words/words-tests.factor @@ -183,3 +183,16 @@ SYMBOL: quot-uses-b [ t ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test [ ] [ "IN: words.tests : decl-forget-test ;" eval ] unit-test [ f ] [ "decl-forget-test" "words.tests" lookup "flushable" word-prop ] unit-test + +[ { } ] +[ + all-words [ + "compiled-uses" word-prop + keys [ "forgotten" word-prop ] contains? + ] filter +] unit-test + +[ { } ] [ + crossref get keys + [ word? ] filter [ "forgotten" word-prop ] filter +] unit-test diff --git a/core/words/words.factor b/core/words/words.factor index 22d22d83fb..226c4949ff 100755 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -80,8 +80,7 @@ GENERIC# (quot-uses) 1 ( obj assoc -- ) M: object (quot-uses) 2drop ; -M: word (quot-uses) - >r dup crossref? [ dup r> set-at ] [ r> 2drop ] if ; +M: word (quot-uses) over crossref? [ conjoin ] [ 2drop ] if ; : seq-uses ( seq assoc -- ) [ (quot-uses) ] curry each ; @@ -103,12 +102,16 @@ compiled-crossref global [ H{ } assoc-like ] change-at : compiled-xref ( word dependencies -- ) [ drop crossref? ] assoc-filter - 2dup "compiled-uses" set-word-prop - compiled-crossref get add-vertex* ; + [ "compiled-uses" set-word-prop ] + [ compiled-crossref get add-vertex* ] + 2bi ; : compiled-unxref ( word -- ) - dup "compiled-uses" word-prop - compiled-crossref get remove-vertex* ; + [ + dup "compiled-uses" word-prop + compiled-crossref get remove-vertex* + ] + [ f "compiled-uses" set-word-prop ] bi ; : delete-compiled-xref ( word -- ) dup compiled-unxref @@ -177,9 +180,10 @@ GENERIC: subwords ( word -- seq ) M: word subwords drop f ; : reset-generic ( word -- ) - dup subwords forget-all - dup reset-word - { "methods" "combination" "default-method" } reset-props ; + [ subwords forget-all ] + [ reset-word ] + [ { "methods" "combination" "default-method" } reset-props ] + tri ; : gensym ( -- word ) "( gensym )" f ; @@ -216,12 +220,12 @@ M: word where "loc" word-prop ; M: word set-where swap "loc" set-word-prop ; M: word forget* - dup "forgotten" word-prop [ - dup delete-xref - dup delete-compiled-xref - dup word-name over word-vocabulary vocab-words delete-at - dup t "forgotten" set-word-prop - ] unless drop ; + dup "forgotten" word-prop [ drop ] [ + [ delete-xref ] + [ [ word-name ] [ word-vocabulary vocab-words ] bi delete-at ] + [ t "forgotten" set-word-prop ] + tri + ] if ; M: word hashcode* nip 1 slot { fixnum } declare ; diff --git a/extra/concurrency/conditions/conditions.factor b/extra/concurrency/conditions/conditions.factor index b10aded671..72f520dab3 100755 --- a/extra/concurrency/conditions/conditions.factor +++ b/extra/concurrency/conditions/conditions.factor @@ -1,21 +1,20 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: dlists dlists.private threads kernel arrays sequences -alarms ; +USING: dequeues threads kernel arrays sequences alarms ; IN: concurrency.conditions -: notify-1 ( dlist -- ) - dup dlist-empty? [ drop ] [ pop-back resume-now ] if ; +: notify-1 ( dequeue -- ) + dup dequeue-empty? [ drop ] [ pop-back resume-now ] if ; -: notify-all ( dlist -- ) - [ resume-now ] dlist-slurp ; +: notify-all ( dequeue -- ) + [ resume-now ] slurp-dequeue ; : queue-timeout ( queue timeout -- alarm ) #! Add an alarm which removes the current thread from the #! queue, and resumes it, passing it a value of t. - >r self over push-front* [ - tuck delete-node - dlist-node-obj t swap resume-with + >r [ self swap push-front* ] keep [ + [ delete-node ] [ drop node-value ] 2bi + t swap resume-with ] 2curry r> later ; : wait ( queue timeout status -- ) diff --git a/extra/concurrency/locks/locks.factor b/extra/concurrency/locks/locks.factor index b5ea247420..2ab204e91d 100755 --- a/extra/concurrency/locks/locks.factor +++ b/extra/concurrency/locks/locks.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: dlists kernel threads continuations math +USING: dequeues dlists kernel threads continuations math concurrency.conditions ; IN: concurrency.locks @@ -80,7 +80,7 @@ TUPLE: rw-lock readers writers reader# writer ; : release-write-lock ( lock -- ) f over set-rw-lock-writer - dup rw-lock-readers dlist-empty? + dup rw-lock-readers dequeue-empty? [ notify-writer ] [ rw-lock-readers notify-all ] if ; : reentrant-read-lock-ok? ( lock -- ? ) diff --git a/extra/concurrency/mailboxes/mailboxes.factor b/extra/concurrency/mailboxes/mailboxes.factor index aa03d3d8ee..86d3297a28 100755 --- a/extra/concurrency/mailboxes/mailboxes.factor +++ b/extra/concurrency/mailboxes/mailboxes.factor @@ -1,9 +1,10 @@ ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: concurrency.mailboxes -USING: dlists threads sequences continuations destructors -namespaces random math quotations words kernel arrays assocs -init system concurrency.conditions accessors debugger ; +USING: dlists dequeues threads sequences continuations +destructors namespaces random math quotations words kernel +arrays assocs init system concurrency.conditions accessors +debugger ; TUPLE: mailbox threads data disposed ; @@ -13,7 +14,7 @@ M: mailbox dispose* threads>> notify-all ; f mailbox boa ; : mailbox-empty? ( mailbox -- bool ) - data>> dlist-empty? ; + data>> dequeue-empty? ; : mailbox-put ( obj mailbox -- ) [ data>> push-front ] diff --git a/extra/concurrency/messaging/messaging-tests.factor b/extra/concurrency/messaging/messaging-tests.factor index 00184bac05..929c4d44f4 100755 --- a/extra/concurrency/messaging/messaging-tests.factor +++ b/extra/concurrency/messaging/messaging-tests.factor @@ -2,12 +2,12 @@ ! See http://factorcode.org/license.txt for BSD license. ! USING: kernel threads vectors arrays sequences -namespaces tools.test continuations dlists strings math words +namespaces tools.test continuations dequeues strings math words match quotations concurrency.messaging concurrency.mailboxes concurrency.count-downs accessors ; IN: concurrency.messaging.tests -[ ] [ my-mailbox mailbox-data dlist-delete-all ] unit-test +[ ] [ my-mailbox mailbox-data clear-dequeue ] unit-test [ "received" ] [ [ diff --git a/extra/help/lint/lint.factor b/extra/help/lint/lint.factor index 2a8ea03d03..00a8e287e6 100755 --- a/extra/help/lint/lint.factor +++ b/extra/help/lint/lint.factor @@ -5,7 +5,7 @@ words strings classes tools.vocabs namespaces io io.streams.string prettyprint definitions arrays vectors combinators splitting debugger hashtables sorting effects vocabs vocabs.loader assocs editors continuations classes.predicate -macros combinators.lib sequences.lib math sets ; +macros math sets ; IN: help.lint : check-example ( element -- ) @@ -46,16 +46,15 @@ IN: help.lint : check-values ( word element -- ) { - [ over "declared-effect" word-prop ] - [ dup contains-funky-elements? not ] - [ over macro? not ] + { [ over "declared-effect" word-prop ] [ 2drop ] } + { [ dup contains-funky-elements? not ] [ 2drop ] } + { [ over macro? not ] [ 2drop ] } [ - 2dup extract-values >array - >r effect-values >array - r> assert= - t + [ effect-values >array ] + [ extract-values >array ] + bi* assert= ] - } 0&& 3drop ; + } cond ; : check-see-also ( word element -- ) nip \ $see-also swap elements [ @@ -114,7 +113,10 @@ M: help-error error. vocabs [ dup vocab-docs-path swap ] H{ } map>assoc H{ } clone [ [ - >r >r dup >link where ?first r> at r> [ ?push ] change-at + >r >r dup >link where dup + [ first r> at r> [ ?push ] change-at ] + [ r> r> 2drop 2drop ] + if ] 2curry each ] keep ; diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 171f8122c5..98cf3e5769 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -1,5 +1,5 @@ USING: io.files kernel sequences accessors -dlists arrays sequences.lib ; +dlists dequeues arrays sequences.lib ; IN: io.paths TUPLE: directory-iterator path bfs queue ; @@ -18,7 +18,7 @@ TUPLE: directory-iterator path bfs queue ; dup path>> over push-directory ; : next-file ( iter -- file/f ) - dup queue>> dlist-empty? [ drop f ] [ + dup queue>> dequeue-empty? [ drop f ] [ dup queue>> pop-back first2 [ over push-directory next-file ] [ nip ] if ] if ; diff --git a/extra/logging/logging.factor b/extra/logging/logging.factor index 3cedacc2ae..f46fcf6c53 100755 --- a/extra/logging/logging.factor +++ b/extra/logging/logging.factor @@ -4,7 +4,7 @@ USING: logging.server sequences namespaces concurrency.messaging words kernel arrays shuffle tools.annotations prettyprint.config prettyprint debugger io.streams.string splitting continuations effects arrays.lib parser strings -combinators.lib quotations fry symbols accessors ; +quotations fry symbols accessors ; IN: logging SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ; @@ -42,21 +42,18 @@ SYMBOL: log-service message ( obj -- inputs>message ) - dup one-string? [ first ] [ - H{ - { string-limit f } - { line-limit 1 } - { nesting-limit 3 } - { margin 0 } - } clone [ unparse ] bind + dup one-string-array? [ first ] [ + [ + string-limit off + 1 line-limit set + 3 nesting-limit set + 0 margin set + unparse + ] with-scope ] if ; PRIVATE> diff --git a/extra/macros/macros-docs.factor b/extra/macros/macros-docs.factor index 44d1f32c8f..022458cc7c 100644 --- a/extra/macros/macros-docs.factor +++ b/extra/macros/macros-docs.factor @@ -21,7 +21,7 @@ HELP: macro-expand { $values { "..." "inputs to a macro" } { "word" macro } { "quot" quotation } } { $description "Expands a macro. Useful for debugging." } { $examples - { $code "{ [ dup integer? ] [ dup 0 > ] [ dup 13 mod zero? ] } \ && macro-expand ." } + { $code "USING: math macros combinators.lib ;" "{ [ integer? ] [ 0 > ] [ 13 mod zero? ] } \ 1&& macro-expand ." } } ; ARTICLE: "macros" "Macros" @@ -31,9 +31,6 @@ $nl { $subsection POSTPONE: MACRO: } "Expanding macros for debugging purposes:" { $subsection macro-expand } -! "Two sample macros which implement short-circuiting boolean operators (as found in C, Java and similar languages):" -! { $subsection && } -! { $subsection || } "Macros are really just a very thin layer of syntax sugar over " { $link "compiler-transforms" } "." ; ABOUT: "macros" diff --git a/extra/macros/macros-tests.factor b/extra/macros/macros-tests.factor index d5011b0ecb..91527c2125 100644 --- a/extra/macros/macros-tests.factor +++ b/extra/macros/macros-tests.factor @@ -12,3 +12,6 @@ unit-test "USING: math ;\nIN: macros.tests\n: see-test ( a b -- c ) - ;\n" dup eval [ \ see-test see ] with-string-writer = ] unit-test + +[ ] [ "USING: macros inference kernel ; IN: hanging-macro MACRO: c ( quot -- ) infer drop [ ] ; : a ( -- ) [ a ] c ;" eval ] unit-test + diff --git a/extra/multi-methods/multi-methods.factor b/extra/multi-methods/multi-methods.factor index e2a18e2f78..fe6945d3f7 100755 --- a/extra/multi-methods/multi-methods.factor +++ b/extra/multi-methods/multi-methods.factor @@ -154,7 +154,7 @@ M: method-body stack-effect "multi-method-generic" word-prop stack-effect ; M: method-body crossref? - drop t ; + "forgotten" word-prop not ; : method-word-name ( specializer generic -- string ) [ word-name % "-" % unparse % ] "" make ; diff --git a/extra/sequences/deep/tags.txt b/extra/sequences/deep/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/sequences/deep/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/sequences/modified/tags.txt b/extra/sequences/modified/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/sequences/modified/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/sequences/repeating/tags.txt b/extra/sequences/repeating/tags.txt new file mode 100644 index 0000000000..42d711b32b --- /dev/null +++ b/extra/sequences/repeating/tags.txt @@ -0,0 +1 @@ +collections diff --git a/extra/serialize/serialize-tests.factor b/extra/serialize/serialize-tests.factor index c5734b2ae8..638c91553f 100755 --- a/extra/serialize/serialize-tests.factor +++ b/extra/serialize/serialize-tests.factor @@ -4,7 +4,7 @@ USING: tools.test kernel serialize io io.streams.byte-array math alien arrays byte-arrays sequences math prettyprint parser classes math.constants io.encodings.binary random -combinators.lib assocs ; +assocs ; IN: serialize.tests : test-serialize-cell @@ -15,12 +15,11 @@ IN: serialize.tests [ t ] [ 100 [ drop - { - [ 40 [ test-serialize-cell ] all? ] - [ 4 [ 40 * test-serialize-cell ] all? ] - [ 4 [ 400 * test-serialize-cell ] all? ] - [ 4 [ 4000 * test-serialize-cell ] all? ] - } && + 40 [ test-serialize-cell ] all? + 4 [ 40 * test-serialize-cell ] all? + 4 [ 400 * test-serialize-cell ] all? + 4 [ 4000 * test-serialize-cell ] all? + and and and ] all? ] unit-test diff --git a/extra/tools/deploy/shaker/strip-debugger.factor b/extra/tools/deploy/shaker/strip-debugger.factor index 5caab02e69..2302b61715 100755 --- a/extra/tools/deploy/shaker/strip-debugger.factor +++ b/extra/tools/deploy/shaker/strip-debugger.factor @@ -1,8 +1,8 @@ USING: kernel threads threads.private ; IN: debugger -: print-error die ; +: print-error ( error -- ) die drop ; -: error. die ; +: error. ( error -- ) die drop ; M: thread error-in-thread ( error thread -- ) die 2drop ; diff --git a/extra/tools/deploy/shaker/strip-libc.factor b/extra/tools/deploy/shaker/strip-libc.factor index ba1436fd17..9c2dc4e8ec 100755 --- a/extra/tools/deploy/shaker/strip-libc.factor +++ b/extra/tools/deploy/shaker/strip-libc.factor @@ -1,10 +1,10 @@ USING: libc.private ; IN: libc -: malloc (malloc) check-ptr ; +: malloc ( size -- newalien ) (malloc) check-ptr ; -: realloc (realloc) check-ptr ; +: realloc ( alien size -- newalien ) (realloc) check-ptr ; -: calloc (calloc) check-ptr ; +: calloc ( size count -- newalien ) (calloc) check-ptr ; -: free (free) ; +: free ( alien -- ) (free) ; diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index f88b207603..ff2b4848ea 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/extra/ui/gadgets/gadgets-tests.factor @@ -1,6 +1,6 @@ IN: ui.gadgets.tests USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test -namespaces models kernel dlists math sets +namespaces models kernel dlists dequeues math sets math.parser ui sequences hashtables assocs io arrays prettyprint io.streams.string ; @@ -130,26 +130,26 @@ M: mock-gadget ungraft* [ \ graft-queue [ [ ] [ dup queue-graft unqueue-graft ] unit-test - [ t ] [ graft-queue dlist-empty? ] unit-test + [ t ] [ graft-queue dequeue-empty? ] unit-test ] with-variable \ graft-queue [ - [ t ] [ graft-queue dlist-empty? ] unit-test + [ t ] [ graft-queue dequeue-empty? ] unit-test "g" set [ ] [ "g" get queue-graft ] unit-test - [ f ] [ graft-queue dlist-empty? ] unit-test + [ f ] [ graft-queue dequeue-empty? ] unit-test [ { f t } ] [ "g" get gadget-graft-state ] unit-test [ ] [ "g" get graft-later ] unit-test [ { f t } ] [ "g" get gadget-graft-state ] unit-test [ ] [ "g" get ungraft-later ] unit-test [ { f f } ] [ "g" get gadget-graft-state ] unit-test - [ t ] [ graft-queue dlist-empty? ] unit-test + [ t ] [ graft-queue dequeue-empty? ] unit-test [ ] [ "g" get ungraft-later ] unit-test [ ] [ "g" get graft-later ] unit-test [ ] [ notify-queued ] unit-test [ { t t } ] [ "g" get gadget-graft-state ] unit-test - [ t ] [ graft-queue dlist-empty? ] unit-test + [ t ] [ graft-queue dequeue-empty? ] unit-test [ ] [ "g" get graft-later ] unit-test [ 1 ] [ "g" get mock-gadget-graft-called ] unit-test [ ] [ "g" get ungraft-later ] unit-test @@ -185,7 +185,7 @@ M: mock-gadget ungraft* [ { f t } ] [ "1" get gadget-graft-state ] unit-test [ { f t } ] [ "2" get gadget-graft-state ] unit-test [ { f t } ] [ "3" get gadget-graft-state ] unit-test - [ ] [ [ "x" print notify ] graft-queue swap dlist-slurp ] unit-test + [ ] [ graft-queue [ "x" print notify ] slurp-dequeue ] unit-test [ ] [ notify-queued ] unit-test [ V{ { t t } } ] [ status-flags ] unit-test ] with-variable ; diff --git a/extra/ui/gadgets/gadgets.factor b/extra/ui/gadgets/gadgets.factor index db750d924d..e4f929ed8e 100755 --- a/extra/ui/gadgets/gadgets.factor +++ b/extra/ui/gadgets/gadgets.factor @@ -1,8 +1,8 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays hashtables kernel models math namespaces sequences -quotations math.vectors combinators sorting vectors dlists -models threads concurrency.flags math.order ; +USING: accessors arrays hashtables kernel models math namespaces +sequences quotations math.vectors combinators sorting vectors +dlists dequeues models threads concurrency.flags math.order ; IN: ui.gadgets SYMBOL: ui-notify-flag @@ -252,13 +252,12 @@ M: gadget layout* drop ; : graft-queue ( -- dlist ) \ graft-queue get ; : unqueue-graft ( gadget -- ) - graft-queue over gadget-graft-node delete-node - dup gadget-graft-state first { t t } { f f } ? - swap set-gadget-graft-state ; + [ graft-node>> graft-queue delete-node ] + [ [ first { t t } { f f } ? ] change-graft-state drop ] bi ; : (queue-graft) ( gadget flags -- ) - over set-gadget-graft-state - dup graft-queue push-front* swap set-gadget-graft-node + >>graft-state + dup graft-queue push-front* >>graft-node drop notify-ui-thread ; : queue-graft ( gadget -- ) diff --git a/extra/ui/tools/browser/browser.factor b/extra/ui/tools/browser/browser.factor index 50a3b61343..ae39b3e116 100755 --- a/extra/ui/tools/browser/browser.factor +++ b/extra/ui/tools/browser/browser.factor @@ -14,7 +14,7 @@ TUPLE: browser-gadget pane history ; >r >link r> history>> set-model ; : ( browser-gadget -- gadget ) - history>> [ [ dup help ] try drop ] ; + history>> [ [ help ] curry try ] ; : init-history ( browser-gadget -- ) "handbook" >link >>history drop ; diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor index 7aca45a210..d8ba50ddaf 100755 --- a/extra/ui/ui.factor +++ b/extra/ui/ui.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2006, 2007 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs io kernel math models namespaces -prettyprint dlists sequences threads sequences words +prettyprint dlists dequeues sequences threads sequences words debugger ui.gadgets ui.gadgets.worlds ui.gadgets.tracks ui.gestures ui.backend ui.render continuations init combinators hashtables concurrency.flags sets ; @@ -15,7 +15,7 @@ SYMBOL: stop-after-last-window? : event-loop? ( -- ? ) { { [ stop-after-last-window? get not ] [ t ] } - { [ graft-queue dlist-empty? not ] [ t ] } + { [ graft-queue dequeue-empty? not ] [ t ] } { [ windows get-global empty? not ] [ t ] } [ f ] } cond ; @@ -126,7 +126,7 @@ SYMBOL: ui-hook in-layout? on layout-queue [ dup layout find-world [ , ] when* - ] dlist-slurp + ] slurp-dequeue ] { } make prune ; : redraw-worlds ( seq -- ) @@ -141,7 +141,7 @@ SYMBOL: ui-hook } case ; : notify-queued ( -- ) - graft-queue [ notify ] dlist-slurp ; + graft-queue [ notify ] slurp-dequeue ; : update-ui ( -- ) [ notify-queued layout-queued redraw-worlds ] assert-depth ;