Bug fixes and cleanups

diff --git a/core/alien/compiler/compiler.factor b/core/alien/compiler/compiler.factor
index ac1895e37e0079f661fb3549985b3ac675c159a8..60bbbcd259497888d5e35c7dea78d7a320c38683 100755 (executable)
--- 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 b33773cf9e06a8735d7a239d9b37c136fd098f78..0e1042391c73d3e1b45e0fd4c742164b8db3d0f8 100755 (executable)
--- 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 15afce3e936fc18b3f988677bb5e4d41015b8369..ca49b550b0d1896d34756503429a7ed244bcddb1 100755 (executable)
--- 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 593213c5c637e9912155939e9d754172f267f9fa..096c620c284bbe75a2ef4018dd83a7c9a0a165c3 100755 (executable)
--- 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 9ffcd952e3008243c0d7d0cd5b29226426fb0f31..e70e64980584ad6d34d78b8b003056354add3e2c 100755 (executable)
--- 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 8c653b866e4e4e7d99e1c73a72e2b9a1e42b3e83..4ee2fd5cdf7a0712640782a3076fc1fade4880ff 100755 (executable)
--- 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
+        <hashed-dlist> 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 (file)
index 0000000..79e17f7
--- /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 (file)
index b87898c..0000000
--- 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 (file)
index 0000000..b7abacc
--- /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 (file)
index 0000000..107381c
--- /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 (file)
index 0000000..2b27b64
--- /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 (file)
index 0000000..1e31757
--- /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 658a64315ee45c2805eef4e8a45c78a6b496af38..b0c4948956b682cf72bb8dc122e493d4d4d6574f 100755 (executable)
--- 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 684c058913d3a3f6351d6909d6d884fde1d98649..7e64935e07a3fb7c883c42b7cad11a458dc95491 100755 (executable)
--- 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 fb9820008a575abef8584fc07a5c4f3e7ff98c0c..965c9d8ad8cc4a234efaab51bc5a64acb3b44978 100755 (executable)
--- 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 ;
 
 : <default-method> ( generic combination -- method )
-    object bootstrap-word pick <method>
-    [ -rot make-default-method define ] keep ;
+    [ drop object bootstrap-word swap <method> ] [ make-default-method ] 2bi
+    [ define ] [ drop t "default" set-word-prop ] [ drop ] 2tri ;
 
 : define-default-method ( generic combination -- )
     dupd <default-method> "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 9a780383b5c2d3278cc13c5d90b0dd6d52e88674..2654490d88cba7e66a53cf2de2ce4e64834aea8d 100644 (file)
--- 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 973d49f1fad2070a0286a7cbf4d9b9d63e24827f..792b2ab340a6051c565aaafd62dc8b4fd8860ced 100644 (file)
--- 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 080e77af02a30432467c2df278492a098d838f0a..de5ca6d5e6ec148183275c4da96d4cbf01361c61 100755 (executable)
--- 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 7f073bfad966861eb52e322bff1bb5916032f339..c9c3f1de6bacf858cd4e00716c886927556bbf73 100755 (executable)
--- 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 d73e43cdfc1199cb2b8d1cfea2ddc3ecc9e48f6f..da9e6ff10d0935c571c9324bf42f37cab5680505 100755 (executable)
--- 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 dff6e9e0f174f13112fac52abb04e42c353f0dee..cda5260397832e713616baeda8c676b20ddd4588 100755 (executable)
--- 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
 
 <PRIVATE
@@ -38,7 +38,7 @@ ERROR: realloc-error ptr size ;
 [ H{ } clone mallocs set-global ] "libc" add-init-hook
 
 : add-malloc ( alien -- )
-    dup mallocs get-global set-at ;
+    mallocs get-global conjoin ;
 
 : delete-malloc ( alien -- )
     [

diff --git a/core/parser/parser-tests.factor b/core/parser/parser-tests.factor
index df6c9dadc5f072b6e3bcd81cd24a239b91b09683..555c6eb32c9a73b3a3724f52e77eafd74d7fda67 100755 (executable)
--- a/core/parser/parser-tests.factor
+++ b/core/parser/parser-tests.factor
@@ -421,8 +421,6 @@ must-fail-with
     ] unit-test
 ] times
 
-[ ] [ "parser" reload ] unit-test
-
 [ ] [
     [ "this-better-not-exist" forget-vocab ] with-compilation-unit
 ] unit-test

diff --git a/core/prettyprint/sections/sections.factor b/core/prettyprint/sections/sections.factor
index bc88e1e8107e3df2044c69bcc144d9b2c5d6c150..2f81207ab54e6a3cb0f32329e5ce2ac5c4927686 100644 (file)
--- a/core/prettyprint/sections/sections.factor
+++ b/core/prettyprint/sections/sections.factor
@@ -3,7 +3,7 @@
 USING: arrays generic hashtables io kernel math assocs
 namespaces sequences strings io.styles vectors words
 prettyprint.config splitting classes continuations
-io.streams.nested accessors ;
+io.streams.nested accessors sets ;
 IN: prettyprint.sections
 
 ! State
@@ -20,7 +20,7 @@ TUPLE: pprinter last-newline line-count indent ;
 : <pprinter> ( -- 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 (file)
index 0000000..1901f27
--- /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 fb3309543a1ca0ec765ad4a50e95ba8e6978bd61..de9e9f00840cfa82d967008a05ca4007091fb96c 100644 (file)
--- a/core/search-dequeues/search-dequeues-docs.factor
+++ b/core/search-dequeues/search-dequeues-docs.factor
@@ -10,6 +10,8 @@ $nl
 "Default implementation:"
 { $subsection <hashed-dlist> } ;
 
+ABOUT: "search-dequeues"
+
 HELP: <search-dequeue> ( 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 (file)
index 0000000..9102bf2
--- /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 (file)
index 0000000..42d711b
--- /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 81384a40c452536067dabfab934d4da6386f3d7a..60c75a89208601ea6cbdb4ad70b87661f23b6a91 100755 (executable)
--- 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 a0d601e2ad76718d82d6ab876a775971ab401189..6361ddad6178544a62427784a3a1f4ac9716c4f9 100755 (executable)
--- 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 7d8791d493c80bda4c15f0094ebaa15ab5810b86..944526e05ccfce6945244757187392c505b51144 100755 (executable)
--- 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 c23ced42b9be999344bae00b3b5caf69a55e5744..4fe4c5bcb2b54c7fa6a96b56baa4c1020d5c7a2c 100755 (executable)
--- 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 2a164ab11dae747b19d12c8e00a96a3f8c9069cd..13be1adb6955fa0401e0b05aea5db5a907f55e99 100755 (executable)
--- 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 22d22d83fbf0a249923cd27b0512cb7ceca995d8..226c4949ff298253bf653b3c41cea15e2a7c7d6c 100755 (executable)
--- 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 <word> ;
@@ -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 b10aded671ed73c73e711889c248c0bb8a8724fc..72f520dab32bb9ba56c74e30ac5d2d83a7b6186b 100755 (executable)
--- a/extra/concurrency/conditions/conditions.factor
+++ b/extra/concurrency/conditions/conditions.factor
@@ -1,21 +1,20 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: dlists dlists.private threads kernel arrays sequences\r
-alarms ;\r
+USING: dequeues threads kernel arrays sequences alarms ;\r
 IN: concurrency.conditions\r
 \r
-: notify-1 ( dlist -- )\r
-    dup dlist-empty? [ drop ] [ pop-back resume-now ] if ;\r
+: notify-1 ( dequeue -- )\r
+    dup dequeue-empty? [ drop ] [ pop-back resume-now ] if ;\r
 \r
-: notify-all ( dlist -- )\r
-    [ resume-now ] dlist-slurp ;\r
+: notify-all ( dequeue -- )\r
+    [ resume-now ] slurp-dequeue ;\r
 \r
 : queue-timeout ( queue timeout -- alarm )\r
     #! Add an alarm which removes the current thread from the\r
     #! queue, and resumes it, passing it a value of t.\r
-    >r self over push-front* [\r
-        tuck delete-node\r
-        dlist-node-obj t swap resume-with\r
+    >r [ self swap push-front* ] keep [\r
+        [ delete-node ] [ drop node-value ] 2bi\r
+        t swap resume-with\r
     ] 2curry r> later ;\r
 \r
 : wait ( queue timeout status -- )\r

diff --git a/extra/concurrency/locks/locks.factor b/extra/concurrency/locks/locks.factor
index b5ea247420ec515e11129e00d62268dd24200fe9..2ab204e91dc00e5df3a1de68b628514dfe24fd5f 100755 (executable)
--- a/extra/concurrency/locks/locks.factor
+++ b/extra/concurrency/locks/locks.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
-USING: dlists kernel threads continuations math\r
+USING: dequeues dlists kernel threads continuations math\r
 concurrency.conditions ;\r
 IN: concurrency.locks\r
 \r
@@ -80,7 +80,7 @@ TUPLE: rw-lock readers writers reader# writer ;
 \r
 : release-write-lock ( lock -- )\r
     f over set-rw-lock-writer\r
-    dup rw-lock-readers dlist-empty?\r
+    dup rw-lock-readers dequeue-empty?\r
     [ notify-writer ] [ rw-lock-readers notify-all ] if ;\r
 \r
 : reentrant-read-lock-ok? ( lock -- ? )\r

diff --git a/extra/concurrency/mailboxes/mailboxes.factor b/extra/concurrency/mailboxes/mailboxes.factor
index aa03d3d8ee0382326925f9fecd91868d56aa39da..86d3297a28c1f126b090d9190a76f3efcc622770 100755 (executable)
--- a/extra/concurrency/mailboxes/mailboxes.factor
+++ b/extra/concurrency/mailboxes/mailboxes.factor
@@ -1,9 +1,10 @@
 ! Copyright (C) 2005, 2008 Chris Double, Slava Pestov.\r
 ! See http://factorcode.org/license.txt for BSD license.\r
 IN: concurrency.mailboxes\r
-USING: dlists threads sequences continuations destructors\r
-namespaces random math quotations words kernel arrays assocs\r
-init system concurrency.conditions accessors debugger ;\r
+USING: dlists dequeues threads sequences continuations\r
+destructors namespaces random math quotations words kernel\r
+arrays assocs init system concurrency.conditions accessors\r
+debugger ;\r
 \r
 TUPLE: mailbox threads data disposed ;\r
 \r
@@ -13,7 +14,7 @@ M: mailbox dispose* threads>> notify-all ;
     <dlist> <dlist> f mailbox boa ;\r
 \r
 : mailbox-empty? ( mailbox -- bool )\r
-    data>> dlist-empty? ;\r
+    data>> dequeue-empty? ;\r
 \r
 : mailbox-put ( obj mailbox -- )\r
     [ data>> push-front ]\r

diff --git a/extra/concurrency/messaging/messaging-tests.factor b/extra/concurrency/messaging/messaging-tests.factor
index 00184bac05413a334ab240f780815bfc30f2dd93..929c4d44f49611ed3cb45322c5d4560f8e21f34b 100755 (executable)
--- 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 2a8ea03d039753d5f1c0619916676240820b19a6..00a8e287e637fb9d158b020fa6a6d2e5693af1e9 100755 (executable)
--- 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 171f8122c532a2ee83a75536d020398384c89da5..98cf3e576960bf17d8cef35fae5d3b4ac33ff1f5 100755 (executable)
--- 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 3cedacc2ae9d73c82e899f639a0f770d1762cc98..f46fcf6c5324ecf29b82483e3eabcb84e3581fbe 100755 (executable)
--- 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\r
 prettyprint.config prettyprint debugger io.streams.string\r
 splitting continuations effects arrays.lib parser strings\r
-combinators.lib quotations fry symbols accessors ;\r
+quotations fry symbols accessors ;\r
 IN: logging\r
 \r
 SYMBOLS: DEBUG NOTICE WARNING ERROR CRITICAL ;\r
@@ -42,21 +42,18 @@ SYMBOL: log-service
 \r
 <PRIVATE\r
 \r
-: one-string? ( obj -- ? )\r
-    {\r
-        [ dup array? ]\r
-        [ dup length 1 = ]\r
-        [ dup first string? ]\r
-    } 0&& nip ;\r
+PREDICATE: one-string-array < array\r
+    [ length 1 = ] [ [ string? ] all? ] bi and ;\r
 \r
 : stack>message ( obj -- inputs>message )\r
-    dup one-string? [ first ] [\r
-        H{\r
-            { string-limit f }\r
-            { line-limit 1 }\r
-            { nesting-limit 3 }\r
-            { margin 0 }\r
-        } clone [ unparse ] bind\r
+    dup one-string-array? [ first ] [\r
+        [\r
+            string-limit off\r
+            1 line-limit set\r
+            3 nesting-limit set\r
+            0 margin set\r
+            unparse\r
+        ] with-scope\r
     ] if ;\r
 \r
 PRIVATE>\r

diff --git a/extra/macros/macros-docs.factor b/extra/macros/macros-docs.factor
index 44d1f32c8f49b5659a204fc1b3d769e1f7c222bf..022458cc7cac5359317f912b57982a05e004503f 100644 (file)
--- 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 d5011b0ecbd7e3c39879c9acb825638a60d27429..91527c2125e871de354b923931130a015e582795 100644 (file)
--- 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 e2a18e2f78b4f248f6e01fec15bdf49b53d1104c..fe6945d3f7d65a42fa4f0ecb204eedf9725f41af 100755 (executable)
--- 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 (file)
index 0000000..42d711b
--- /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 (file)
index 0000000..42d711b
--- /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 (file)
index 0000000..42d711b
--- /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 c5734b2ae8fb2aac12f5b41670b2d57850573604..638c91553f17429e9206692d58910e4ce0dd9011 100755 (executable)
--- 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 5caab02e6929fcbf703f3e87172113d18673e2ad..2302b617150945b44c651f5d948a2c39382e92da 100755 (executable)
--- 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 ba1436fd1726db5fade874b1f5ee4b13737faa7a..9c2dc4e8ec64c385c633565e8470b1b1c25808cc 100755 (executable)
--- 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 f88b2076038c3b50e11dad47957a7bd57718b8e6..ff2b4848ea7f66cd133021fa9933bd05d26c6f56 100755 (executable)
--- 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*
 [
     <dlist> \ graft-queue [
         [ ] [ <mock-gadget> dup queue-graft unqueue-graft ] unit-test
-        [ t ] [ graft-queue dlist-empty? ] unit-test
+        [ t ] [ graft-queue dequeue-empty? ] unit-test
     ] with-variable
 
     <dlist> \ graft-queue [
-        [ t ] [ graft-queue dlist-empty? ] unit-test
+        [ t ] [ graft-queue dequeue-empty? ] unit-test
 
         <mock-gadget> "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 db750d924d6f5921b6718055207cde2ecea09da6..e4f929ed8e06f672cb9f242bb01f07723603e1d5 100755 (executable)
--- 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 50a3b6134356c6ecb9e9d3bcb6390ea05aaf1aa1..ae39b3e116be15f1684e8fe515542d1d3c618491 100755 (executable)
--- 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 ;
 
 : <help-pane> ( browser-gadget -- gadget )
-    history>> [ [ dup help ] try drop ] <pane-control> ;
+    history>> [ [ help ] curry try ] <pane-control> ;
 
 : init-history ( browser-gadget -- )
     "handbook" >link <history> >>history drop ;

diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor
index 7aca45a21074a1ed622793dfa840b7d55f762d75..d8ba50ddaf2f65432bdabeb7859622acebabf4b9 100755 (executable)
--- 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 ;