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

basis/compiler/compiler.factor

@@ -42,12 +42,17 @@ SYMBOL: +failed+
     [ compiled-unxref ]
     [
         dup crossref?
-        [ dependencies get compiled-xref ] [ drop ] if
+        [
+            dependencies get
+            generic-dependencies get
+            compiled-xref
+        ] [ drop ] if
     ] tri ;
 
 : (compile) ( word -- )
     '[
         H{ } clone dependencies set
+        H{ } clone generic-dependencies set
 
         , {
             [ compile-begins ]

basis/compiler/tests/insane.factor

@@ -1,4 +1,5 @@
 IN: compiler.tests
-USING: words kernel stack-checker alien.strings tools.test ;
+USING: words kernel stack-checker alien.strings tools.test
+compiler.units ;
 
-[ ] [ \ if redefined [ string>alien ] infer. ] unit-test
+[ ] [ [ \ if redefined ] with-compilation-unit [ string>alien ] infer. ] unit-test

basis/compiler/tests/redefine10.factor

@@ -0,0 +1,29 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine10" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math classes ;
+    IN: compiler.tests.redefine10
+    MIXIN: my-mixin
+    INSTANCE: fixnum my-mixin
+    : my-inline ( a -- b ) dup my-mixin instance? [ 1 + ] when ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USE: math
+    IN: compiler.tests.redefine10
+    INSTANCE: float my-mixin
+    "> eval
+] unit-test
+
+[ 2.0 ] [
+    1.0 "my-inline" "compiler.tests.redefine10" lookup execute
+] unit-test

basis/compiler/tests/redefine11.factor

@@ -0,0 +1,32 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel classes.mixin arrays ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine11" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math classes arrays ;
+    IN: compiler.tests.redefine11
+    MIXIN: my-mixin
+    INSTANCE: array my-mixin
+    INSTANCE: fixnum my-mixin
+    GENERIC: my-generic ( a -- b )
+    M: my-mixin my-generic drop 0 ;
+    M: object my-generic drop 1 ;
+    : my-inline ( -- b ) { } my-generic ;
+    "> eval
+] unit-test
+
+[ ] [
+    [
+        array "my-mixin" "compiler.tests.redefine11" lookup
+        remove-mixin-instance
+    ] with-compilation-unit
+] unit-test
+
+[ 1 ] [
+    "my-inline" "compiler.tests.redefine11" lookup execute
+] unit-test

basis/compiler/tests/redefine6.factor

@@ -0,0 +1,33 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine6" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel kernel.private ;
+    IN: compiler.tests.redefine6
+    GENERIC: my-generic ( a -- b )
+    MIXIN: my-mixin
+    M: my-mixin my-generic drop 0 ;
+    : my-inline ( a -- b ) { my-mixin } declare my-generic ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USING: kernel ;
+    IN: compiler.tests.redefine6
+    TUPLE: my-tuple ;
+    M: my-tuple my-generic drop 1 ;
+    INSTANCE: my-tuple my-mixin
+    "> eval
+] unit-test
+
+[ 1 ] [
+    "my-tuple" "compiler.tests.redefine6" lookup boa
+    "my-inline" "compiler.tests.redefine6" lookup execute
+] unit-test

basis/compiler/tests/redefine7.factor

@@ -0,0 +1,29 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine7" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math ;
+    IN: compiler.tests.redefine7
+    MIXIN: my-mixin
+    INSTANCE: fixnum my-mixin
+    : my-inline ( a -- b ) dup my-mixin? [ 1 + ] when ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USE: math
+    IN: compiler.tests.redefine7
+    INSTANCE: float my-mixin
+    "> eval
+] unit-test
+
+[ 2.0 ] [
+    1.0 "my-inline" "compiler.tests.redefine7" lookup execute
+] unit-test

basis/compiler/tests/redefine8.factor

@@ -0,0 +1,32 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine8" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math math.order sorting ;
+    IN: compiler.tests.redefine8
+    MIXIN: my-mixin
+    INSTANCE: fixnum my-mixin
+    GENERIC: my-generic ( a -- b )
+    ! We add the bogus quotation here to hinder inlining
+    ! since otherwise we cannot trigger this bug.
+    M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USE: math
+    IN: compiler.tests.redefine8
+    INSTANCE: float my-mixin
+    "> eval
+] unit-test
+
+[ 2.0 ] [
+    1.0 "my-generic" "compiler.tests.redefine8" lookup execute
+] unit-test

basis/compiler/tests/redefine9.factor

@@ -0,0 +1,35 @@
+USING: eval tools.test compiler.units vocabs multiline words
+kernel generic.math ;
+IN: compiler.tests
+
+! Mixin redefinition did not recompile all necessary words.
+
+[ ] [ [ "compiler.tests.redefine9" forget-vocab ] with-compilation-unit ] unit-test
+
+[ ] [
+    <"
+    USING: kernel math math.order sorting ;
+    IN: compiler.tests.redefine9
+    MIXIN: my-mixin
+    INSTANCE: fixnum my-mixin
+    GENERIC: my-generic ( a -- b )
+    ! We add the bogus quotation here to hinder inlining
+    ! since otherwise we cannot trigger this bug.
+    M: my-mixin my-generic 1 + [ [ <=> ] sort ] drop ;
+    "> eval
+] unit-test
+
+[ ] [
+    <"
+    USE: math
+    IN: compiler.tests.redefine9
+    TUPLE: my-tuple ;
+    INSTANCE: my-tuple my-mixin
+    "> eval
+] unit-test
+
+[
+    "my-tuple" "compiler.tests.redefine9" lookup boa
+    "my-generic" "compiler.tests.redefine9" lookup
+    execute
+] [ no-math-method? ] must-fail-with

basis/compiler/tree/cleanup/cleanup.factor

@@ -42,7 +42,7 @@ GENERIC: cleanup* ( node -- node/nodes )
 : cleanup-folding ( #call -- nodes )
     #! Replace a #call having a known result with a #drop of its
     #! inputs followed by #push nodes for the outputs.
-    [ word>> +inlined+ depends-on ]
+    [ word>> inlined-dependency depends-on ]
     [
         [ node-output-infos ] [ out-d>> ] bi
         [ [ literal>> ] dip #push ] 2map
@@ -50,11 +50,16 @@ GENERIC: cleanup* ( node -- node/nodes )
     [ in-d>> #drop ]
     tri prefix ;
 
+: add-method-dependency ( #call -- )
+    dup method>> word? [
+        [ word>> ] [ class>> ] bi depends-on-generic
+    ] [ drop ] if ;
+
 : cleanup-inlining ( #call -- nodes )
     [
         dup method>>
-        [ method>> dup word? [ +called+ depends-on ] [ drop ] if ]
+        [ add-method-dependency ]
-        [ word>> +inlined+ depends-on ] if
+        [ word>> inlined-dependency depends-on ] if
     ] [ body>> cleanup ] bi ;
 
 ! Removing overflow checks

basis/compiler/tree/dead-code/simple/simple.factor

@@ -106,7 +106,7 @@ M: #push remove-dead-code*
     ] [ drop f ] if ;
 
 : remove-flushable-call ( #call -- node )
-    [ word>> +inlined+ depends-on ]
+    [ word>> flushed-dependency depends-on ]
     [ in-d>> #drop remove-dead-code* ]
     bi ;
 

basis/compiler/tree/propagation/inlining/inlining.factor

@@ -24,18 +24,19 @@ M: quotation splicing-nodes
     body>> (propagate) ;
 
 ! Dispatch elimination
-: eliminate-dispatch ( #call word/quot/f -- ? )
+: eliminate-dispatch ( #call class/f word/f -- ? )
-    [
+    dup [
+        [ >>class ] dip
         over method>> over = [ drop ] [
             2dup splicing-nodes
             [ >>method ] [ >>body ] bi*
         ] if
         propagate-body t
-    ] [ f >>method f >>body drop f ] if* ;
+    ] [ 2drop f >>method f >>body f >>class drop f ] if ;
 
-: inlining-standard-method ( #call word -- method/f )
+: inlining-standard-method ( #call word -- class/f method/f )
     [ in-d>> <reversed> ] [ [ dispatch# ] keep ] bi*
-    [ swap nth value-info class>> ] dip
+    [ swap nth value-info class>> dup ] dip
     specific-method ;
 
 : inline-standard-method ( #call word -- ? )
@@ -51,15 +52,17 @@ M: quotation splicing-nodes
         object
     } [ class<= ] with find nip ;
 
-: inlining-math-method ( #call word -- quot/f )
+: inlining-math-method ( #call word -- class/f quot/f )
     swap in-d>>
     first2 [ value-info class>> normalize-math-class ] bi@
-    3dup math-both-known? [ math-method* ] [ 3drop f ] if ;
+    3dup math-both-known?
+    [ math-method* ] [ 3drop f ] if
+    number swap ;
 
 : inline-math-method ( #call word -- ? )
     dupd inlining-math-method eliminate-dispatch ;
 
-: inlining-math-partial ( #call word -- quot/f )
+: inlining-math-partial ( #call word -- class/f quot/f )
     [ "derived-from" word-prop first inlining-math-method ]
     [ nip 1quotation ] 2bi
     [ = not ] [ drop ] 2bi and ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -5,6 +5,8 @@ math.partial-dispatch math.intervals math.parser math.order
 layouts words sequences sequences.private arrays assocs classes
 classes.algebra combinators generic.math splitting fry locals
 classes.tuple alien.accessors classes.tuple.private slots.private
+definitions
+stack-checker.state
 compiler.tree.comparisons
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
@@ -280,6 +282,14 @@ generic-comparison-ops [
 ] +constraints+ set-word-prop
 
 \ instance? [
+    ! We need to force the caller word to recompile when the class
+    ! is redefined, since now we're making assumptions but the
+    ! class definition itself.
     dup literal>> class?
-    [ literal>> predicate-output-infos ] [ 2drop object-info ] if
+    [
+        literal>>
+        [ inlined-dependency depends-on ]
+        [ predicate-output-infos ]
+        bi
+    ] [ 2drop object-info ] if
 ] +outputs+ set-word-prop

basis/compiler/tree/propagation/simple/simple.factor

@@ -2,9 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: fry accessors kernel sequences sequences.private assocs words
 namespaces classes.algebra combinators classes classes.tuple
-classes.tuple.private continuations arrays byte-arrays strings
+classes.tuple.private continuations arrays
-math math.partial-dispatch math.private slots generic
+math math.partial-dispatch math.private slots generic definitions
 generic.standard generic.math
+stack-checker.state
 compiler.tree
 compiler.tree.propagation.info
 compiler.tree.propagation.nodes
@@ -32,7 +33,14 @@ M: #push propagate-before
     [ set-value-info ] 2each ;
 
 M: #declare propagate-before
-    declaration>> [ <class-info> swap refine-value-info ] assoc-each ;
+    #! We need to force the caller word to recompile when the
+    #! classes mentioned in the declaration are redefined, since
+    #! now we're making assumptions but their definitions.
+    declaration>> [
+        [ inlined-dependency depends-on ]
+        [ <class-info> swap refine-value-info ]
+        bi
+    ] assoc-each ;
 
 : predicate-constraints ( value class boolean-value -- constraint )
     [ [ is-instance-of ] dip t--> ]
@@ -74,7 +82,11 @@ M: #declare propagate-before
     } cond 2nip ;
 
 : propagate-predicate ( #call word -- infos )
-    [ in-d>> first value-info ] [ "predicating" word-prop ] bi*
+    #! We need to force the caller word to recompile when the class
+    #! is redefined, since now we're making assumptions but the
+    #! class definition itself.
+    [ in-d>> first value-info ]
+    [ "predicating" word-prop dup inlined-dependency depends-on ] bi*
     predicate-output-infos 1array ;
 
 : default-output-value-infos ( #call word -- infos )

basis/compiler/tree/tree.factor

@@ -17,7 +17,7 @@ TUPLE: #introduce < node out-d ;
 : #introduce ( out-d -- node )
     \ #introduce new swap >>out-d ;
 
-TUPLE: #call < node word in-d out-d body method info ;
+TUPLE: #call < node word in-d out-d body method class info ;
 
 : #call ( inputs outputs word -- node )
     \ #call new

basis/concurrency/locks/locks-tests.factor

@@ -174,7 +174,7 @@ threads sequences calendar accessors ;
     ] ;
 
 [ lock-timeout-test ] [
-    linked-error-thread name>> "Lock timeout-er" =
+    thread>> name>> "Lock timeout-er" =
 ] must-fail-with
 
 :: read/write-test ( -- )

basis/concurrency/locks/locks.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: deques dlists kernel threads continuations math
-concurrency.conditions ;
+concurrency.conditions combinators.short-circuit accessors ;
 IN: concurrency.locks
 
 ! Simple critical sections
@@ -16,13 +16,13 @@ TUPLE: lock threads owner reentrant? ;
 <PRIVATE
 
 : acquire-lock ( lock timeout -- )
-    over lock-owner
+    over owner>>
-    [ 2dup >r lock-threads r> "lock" wait ] when drop
+    [ 2dup >r threads>> r> "lock" wait ] when drop
-    self swap set-lock-owner ;
+    self >>owner drop ;
 
 : release-lock ( lock -- )
-    f over set-lock-owner
+    f >>owner
-    lock-threads notify-1 ;
+    threads>> notify-1 ;
 
 : do-lock ( lock timeout quot acquire release -- )
     >r >r pick rot r> call ! use up  timeout acquire
@@ -34,8 +34,8 @@ TUPLE: lock threads owner reentrant? ;
 PRIVATE>
 
 : with-lock-timeout ( lock timeout quot -- )
-    pick lock-reentrant? [
+    pick reentrant?>> [
-        pick lock-owner self eq? [
+        pick owner>> self eq? [
             2nip call
         ] [
             (with-lock)
@@ -56,44 +56,43 @@ TUPLE: rw-lock readers writers reader# writer ;
 <PRIVATE
 
 : add-reader ( lock -- )
-    dup rw-lock-reader# 1+ swap set-rw-lock-reader# ;
+    [ 1+ ] change-reader# drop ;
 
 : acquire-read-lock ( lock timeout -- )
-    over rw-lock-writer
+    over writer>>
-    [ 2dup >r rw-lock-readers r> "read lock" wait ] when drop
+    [ 2dup >r readers>> r> "read lock" wait ] when drop
     add-reader ;
 
 : notify-writer ( lock -- )
-    rw-lock-writers notify-1 ;
+    writers>> notify-1 ;
 
 : remove-reader ( lock -- )
-    dup rw-lock-reader# 1- swap set-rw-lock-reader# ;
+    [ 1- ] change-reader# drop ;
 
 : release-read-lock ( lock -- )
     dup remove-reader
-    dup rw-lock-reader# zero? [ notify-writer ] [ drop ] if ;
+    dup reader#>> zero? [ notify-writer ] [ drop ] if ;
 
 : acquire-write-lock ( lock timeout -- )
-    over rw-lock-writer pick rw-lock-reader# 0 > or
+    over writer>> pick reader#>> 0 > or
-    [ 2dup >r rw-lock-writers r> "write lock" wait ] when drop
+    [ 2dup >r writers>> r> "write lock" wait ] when drop
-    self swap set-rw-lock-writer ;
+    self >>writer drop ;
 
 : release-write-lock ( lock -- )
-    f over set-rw-lock-writer
+    f >>writer
-    dup rw-lock-readers deque-empty?
+    dup readers>> deque-empty?
-    [ notify-writer ] [ rw-lock-readers notify-all ] if ;
+    [ notify-writer ] [ readers>> notify-all ] if ;
 
 : reentrant-read-lock-ok? ( lock -- ? )
     #! If we already have a write lock, then we can grab a read
     #! lock too.
-    rw-lock-writer self eq? ;
+    writer>> self eq? ;
 
 : reentrant-write-lock-ok? ( lock -- ? )
     #! The only case where we have a writer and > 1 reader is
     #! write -> read re-entrancy, and in this case we prohibit
     #! a further write -> read -> write re-entrancy.
-    dup rw-lock-writer self eq?
+    { [ writer>> self eq? ] [ reader#>> zero? ] } 1&& ;
-    swap rw-lock-reader# zero? and ;
 
 PRIVATE>
 

basis/concurrency/messaging/messaging-tests.factor

@@ -7,7 +7,7 @@ match quotations concurrency.messaging concurrency.mailboxes
 concurrency.count-downs accessors ;
 IN: concurrency.messaging.tests
 
-[ ] [ my-mailbox mailbox-data clear-deque ] unit-test
+[ ] [ my-mailbox data>> clear-deque ] unit-test
 
 [ "received" ] [ 
     [

basis/help/syntax/syntax.factor

@@ -18,5 +18,5 @@ IN: help.syntax
 : ABOUT:
     scan-object
     in get vocab
-    dup +inlined+ changed-definition
+    dup changed-definition
     set-vocab-help ; parsing

basis/hints/hints.factor

@@ -55,7 +55,7 @@ IN: hints
 
 : HINTS:
     scan-word
-    [ +inlined+ changed-definition ]
+    [ redefined ]
     [ parse-definition "specializer" set-word-prop ] bi ;
     parsing
 

basis/multiline/multiline.factor

@@ -1,10 +1,11 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: namespaces parser lexer kernel sequences words quotations math ;
+USING: namespaces parser lexer kernel sequences words quotations math
+accessors ;
 IN: multiline
 
 : next-line-text ( -- str )
-    lexer get dup next-line lexer-line-text ;
+    lexer get dup next-line text>> ;
 
 : (parse-here) ( -- )
     next-line-text [
@@ -22,7 +23,7 @@ IN: multiline
     parse-here 1quotation define-inline ; parsing
 
 : (parse-multiline-string) ( start-index end-text -- end-index )
-    lexer get lexer-line-text [
+    lexer get text>> [
         2dup start
         [ rot dupd >r >r swap subseq % r> r> length + ] [
             rot tail % "\n" % 0
@@ -32,8 +33,8 @@ IN: multiline
 
 : parse-multiline-string ( end-text -- str )
     [
-        lexer get lexer-column swap (parse-multiline-string)
+        lexer get column>> swap (parse-multiline-string)
-        lexer get set-lexer-column
+        lexer get (>>column)
     ] "" make rest but-last ;
 
 : <"

basis/prettyprint/prettyprint-tests.factor

@@ -195,11 +195,11 @@ DEFER: parse-error-file
 
 : string-layout
     {
-        "USING: debugger io kernel lexer ;"
+        "USING: accessors debugger io kernel ;"
         "IN: prettyprint.tests"
         ": string-layout-test ( error -- )"
-        "    \"Expected \" write dup unexpected-want expected>string write"
+        "    \"Expected \" write dup want>> expected>string write"
-        "    \" but got \" write unexpected-got expected>string print ;"
+        "    \" but got \" write got>> expected>string print ;"
     } ;
 
 

basis/prettyprint/sections/sections.factor

@@ -115,10 +115,10 @@ M: object short-section? section-fits? ;
 
 : pprint-section ( section -- )
     dup short-section? [
-        dup section-style [ short-section ] with-style
+        dup style>> [ short-section ] with-style
     ] [
         [ <long-section ]
-        [ dup section-style [ long-section ] with-style ]
+        [ dup style>> [ long-section ] with-style ]
         [ long-section> ]
         tri
     ] if ;

basis/stack-checker/backend/backend.factor

@@ -8,29 +8,6 @@ sets generic.standard.engines.tuple stack-checker.state
 stack-checker.visitor stack-checker.errors ;
 IN: stack-checker.backend
 
-! Word properties we use
-SYMBOL: visited
-
-: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline
-
-: (redefined) ( word -- )
-    dup visited get key? [ drop ] [
-        [ reset-on-redefine reset-props ]
-        [ visited get conjoin ]
-        [
-            crossref get at keys
-            [ word? ] filter
-            [
-                [ reset-on-redefine [ word-prop ] with contains? ]
-                [ inline? ]
-                bi or
-            ] filter
-            [ (redefined) ] each
-        ] tri
-    ] if ;
-
-M: word redefined H{ } clone visited [ (redefined) ] with-variable ;
-
 : push-d ( obj -- ) meta-d get push ;
 
 : pop-d  ( -- obj )
@@ -72,7 +49,7 @@ GENERIC: apply-object ( obj -- )
 
 M: wrapper apply-object
     wrapped>>
-    [ dup word? [ +called+ depends-on ] [ drop ] if ]
+    [ dup word? [ called-dependency depends-on ] [ drop ] if ]
     [ push-literal ]
     bi ;
 
@@ -175,6 +152,7 @@ M: object apply-object push-literal ;
             init-known-values
             stack-visitor off
             dependencies off
+            generic-dependencies off
             [ [ def>> ] [ ] [ ] tri infer-quot-recursive end-infer ]
             [ finish-word current-effect ]
             bi

basis/stack-checker/inlining/inlining.factor

@@ -140,7 +140,7 @@ SYMBOL: enter-out
     ] [ undeclared-recursion-error inference-error ] if ;
 
 : inline-word ( word -- )
-    [ +inlined+ depends-on ]
+    [ inlined-dependency depends-on ]
     [
         {
             { [ dup inline-recursive-label ] [ call-recursive-inline-word ] }

basis/stack-checker/known-words/known-words.factor

@@ -176,7 +176,7 @@ do-primitive alien-invoke alien-indirect alien-callback
 SYMBOL: +primitive+
 
 : non-inline-word ( word -- )
-    dup +called+ depends-on
+    dup called-dependency depends-on
     {
         { [ dup "shuffle" word-prop ] [ infer-shuffle-word ] }
         { [ dup "special" word-prop ] [ infer-special ] }

basis/stack-checker/state/state-tests.factor

@@ -9,22 +9,22 @@ definitions ;
 SYMBOL: a
 SYMBOL: b
 
-[ ] [ a +called+ depends-on ] unit-test
+[ ] [ a called-dependency depends-on ] unit-test
 
-[ H{ { a +called+ } } ] [
+[ H{ { a called-dependency } } ] [
-    [ a +called+ depends-on ] computing-dependencies
+    [ a called-dependency depends-on ] computing-dependencies
 ] unit-test
 
-[ H{ { a +called+ } { b +inlined+ } } ] [
+[ H{ { a called-dependency } { b inlined-dependency } } ] [
     [
-        a +called+ depends-on b +inlined+ depends-on
+        a called-dependency depends-on b inlined-dependency depends-on
     ] computing-dependencies
 ] unit-test
 
-[ H{ { a +inlined+ } { b +inlined+ } } ] [
+[ H{ { a inlined-dependency } { b inlined-dependency } } ] [
     [
-        a +inlined+ depends-on
+        a inlined-dependency depends-on
-        a +called+ depends-on
+        a called-dependency depends-on
-        b +inlined+ depends-on
+        b inlined-dependency depends-on
     ] computing-dependencies
 ] unit-test

basis/stack-checker/state/state.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs namespaces sequences kernel definitions math
-effects accessors words stack-checker.errors ;
+effects accessors words fry classes.algebra stack-checker.errors
+compiler.units ;
 IN: stack-checker.state
 
 : <value> ( -- value ) \ <value> counter ;
@@ -88,9 +89,15 @@ SYMBOL: meta-r
 SYMBOL: dependencies
 
 : depends-on ( word how -- )
-    swap dependencies get dup [
+    dependencies get dup
-        2dup at +inlined+ eq? [ 3drop ] [ set-at ] if
+    [ swap '[ , strongest-dependency ] change-at ] [ 3drop ] if ;
-    ] [ 3drop ] if ;
+
+! Generic words that the current quotation depends on
+SYMBOL: generic-dependencies
+
+: depends-on-generic ( generic class -- )
+    generic-dependencies get dup
+    [ swap '[ null or , class-or ] change-at ] [ 3drop ] if ;
 
 ! Words we've inferred the stack effect of, for rollback
 SYMBOL: recorded

basis/stack-checker/transforms/transforms.factor

@@ -46,7 +46,7 @@ SYMBOL: +transform-n+
     ] [ 2drop give-up-transform ] if ;
 
 : apply-transform ( word -- )
-    [ +inlined+ depends-on ] [
+    [ inlined-dependency depends-on ] [
         [ ]
         [ +transform-quot+ word-prop ]
         [ +transform-n+ word-prop ]
@@ -55,7 +55,7 @@ SYMBOL: +transform-n+
     ] bi ;
 
 : apply-macro ( word -- )
-    [ +inlined+ depends-on ] [
+    [ inlined-dependency depends-on ] [
         [ ]
         [ "macro" word-prop ]
         [ "declared-effect" word-prop in>> length ]
@@ -92,13 +92,13 @@ SYMBOL: +transform-n+
 \ spread [ spread>quot ] 1 define-transform
 
 \ (call-next-method) [
-    [ [ +inlined+ depends-on ] bi@ ] [ next-method-quot ] 2bi
+    [ [ inlined-dependency depends-on ] bi@ ] [ next-method-quot ] 2bi
 ] 2 define-transform
 
 ! Constructors
 \ boa [
     dup tuple-class? [
-        dup +inlined+ depends-on
+        dup inlined-dependency depends-on
         [ "boa-check" word-prop ]
         [ tuple-layout '[ , <tuple-boa> ] ]
         bi append
@@ -107,7 +107,7 @@ SYMBOL: +transform-n+
 
 \ new [
     dup tuple-class? [
-        dup +inlined+ depends-on
+        dup inlined-dependency depends-on
         dup all-slots rest-slice ! delegate slot
         [ [ initial>> literalize , ] each literalize , \ boa , ] [ ] make
     ] [ drop f ] if

basis/tools/deploy/deploy-tests.factor

@@ -35,13 +35,13 @@ namespaces continuations layouts accessors ;
 
 [ t ] [ 1200000 small-enough? ] unit-test
 
-[ ] [ "tetris" shake-and-bake ] unit-test
+! [ ] [ "tetris" shake-and-bake ] unit-test
-
+! 
-[ t ] [ 1500000 small-enough? ] unit-test
+! [ t ] [ 1500000 small-enough? ] unit-test
-
+! 
-[ ] [ "bunny" shake-and-bake ] unit-test
+! [ ] [ "bunny" shake-and-bake ] unit-test
-
+! 
-[ t ] [ 2500000 small-enough? ] unit-test
+! [ t ] [ 2500000 small-enough? ] unit-test
 
 {
     "tools.deploy.test.1"

basis/tools/deploy/test/2/deploy.factor

@@ -1,15 +1,15 @@
 USING: tools.deploy.config ;
 H{
-    { deploy-word-defs? f }
-    { deploy-random? f }
-    { deploy-name "tools.deploy.test.2" }
-    { deploy-threads? t }
-    { deploy-compiler? t }
     { deploy-math? t }
-    { deploy-c-types? f }
+    { deploy-compiler? t }
-    { deploy-io 2 }
+    { deploy-reflection 2 }
-    { deploy-reflection 1 }
     { deploy-ui? f }
-    { "stop-after-last-window?" t }
     { deploy-word-props? f }
+    { deploy-threads? t }
+    { deploy-c-types? f }
+    { deploy-random? f }
+    { "stop-after-last-window?" t }
+    { deploy-name "tools.deploy.test.2" }
+    { deploy-io 2 }
+    { deploy-word-defs? f }
 }

basis/units/units.factor

@@ -39,7 +39,7 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
     [ dimensions 2array ] bi@ =
     [ dimensions-not-equal ] unless ;
 
-: 2values ( dim dim -- val val ) [ dimensioned-value ] bi@ ;
+: 2values ( dim dim -- val val ) [ value>> ] bi@ ;
 
 : <dimension-op ( dim dim -- top bot val val )
     2dup check-dimensions dup dimensions 2swap 2values ;
@@ -56,8 +56,8 @@ M: dimensions-not-equal summary drop "Dimensions do not match" ;
 
 : d* ( d d -- d )
     [ dup number? [ scalar ] when ] bi@
-    [ [ dimensioned-top ] bi@ append ] 2keep
+    [ [ top>> ] bi@ append ] 2keep
-    [ [ dimensioned-bot ] bi@ append ] 2keep
+    [ [ bot>> ] bi@ append ] 2keep
     2values * dimension-op> ;
 
 : d-neg ( d -- d ) -1 d* ;

core/assocs/assocs.factor

@@ -110,6 +110,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
     2dup [ assoc-size ] bi@ + pick new-assoc
     [ rot update ] keep [ swap update ] keep ;
 
+: assoc-combine ( seq -- union )
+    H{ } clone [ dupd update ] reduce ;
+
 : assoc-diff ( assoc1 assoc2 -- diff )
     [ nip key? not ] curry assoc-filter ;
 
@@ -186,7 +189,7 @@ M: sequence assoc-clone-like
     >r >alist r> clone-like ;
 
 M: sequence assoc-like
-    over sequence? [ like ] [ assoc-clone-like ] if ;
+    >r >alist r> like ;
 
 M: sequence >alist ;
 

core/bootstrap/primitives.factor

@@ -35,6 +35,7 @@ H{ } clone sub-primitives set
 H{ } clone dictionary set
 H{ } clone new-classes set
 H{ } clone changed-definitions set
+H{ } clone changed-generics set
 H{ } clone forgotten-definitions set
 H{ } clone root-cache set
 H{ } clone source-files set

core/classes/algebra/algebra-tests.factor

@@ -310,3 +310,8 @@ SINGLETON: sb
 SINGLETON: sc
 
 [ sa ] [ sa { sa sb sc } min-class ] unit-test
+
+[ +lt+ ] [ integer sequence class<=> ] unit-test
+[ +lt+ ] [ sequence object class<=> ] unit-test
+[ +gt+ ] [ object sequence class<=> ] unit-test
+[ +eq+ ] [ integer integer class<=> ] unit-test

core/classes/algebra/algebra.factor

@@ -186,6 +186,13 @@ M: anonymous-complement (classes-intersect?)
         [ [ rank-class ] bi@ < ]
     } cond ;
 
+: class<=> ( first second -- ? )
+    {
+        { [ 2dup class<= not ] [ 2drop +gt+ ] }
+        { [ 2dup swap class<= not ] [ 2drop +lt+ ] }
+        [ [ rank-class ] bi@ <=> ]
+    } cond ;
+
 : class= ( first second -- ? )
     [ class<= ] [ swap class<= ] 2bi and ;
 

core/classes/classes.factor

@@ -122,6 +122,7 @@ M: sequence implementors [ implementors ] gather ;
     dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless
     dup reset-class
     dup deferred? [ dup define-symbol ] when
+    dup redefined
     dup props>>
     r> assoc-union >>props
     dup predicate-word

core/classes/mixin/mixin.factor

@@ -63,8 +63,10 @@ TUPLE: check-mixin-class mixin ;
 
 : remove-mixin-instance ( class mixin -- )
     [
-        [ [ swap remove ] change-mixin-class ] keep
+        [ class-usages update-methods ]
-        update-classes
+        [ [ swap remove ] change-mixin-class ]
+        [ nip update-classes ]
+        2tri
     ] [ 2drop ] if-mixin-member? ;
 
 M: mixin-class class-forgotten remove-mixin-instance ;

core/classes/tuple/tuple.factor

@@ -227,9 +227,8 @@ M: tuple-class update-class
         2drop
         [
             [ update-tuples-after ]
-            [ +inlined+ changed-definition ]
             [ redefined ]
-            tri
+            bi
         ] each-subclass
     ]
     [ define-new-tuple-class ]
@@ -270,9 +269,6 @@ M: tuple-class define-tuple-class
         tri* define-declared
     ] 3tri ;
 
-M: tuple-class update-generic
-    over new-class? [ 2drop ] [ call-next-method ] if ;
-
 M: tuple-class reset-class
     [
         dup "slots" word-prop [

core/compiler/units/units-tests.factor

@@ -0,0 +1,9 @@
+IN: compiler.units.tests
+USING: definitions compiler.units tools.test arrays sequences ;
+
+[ flushed-dependency ] [ f flushed-dependency strongest-dependency ] unit-test
+[ flushed-dependency ] [ flushed-dependency f strongest-dependency ] unit-test
+[ inlined-dependency ] [ flushed-dependency inlined-dependency strongest-dependency ] unit-test
+[ inlined-dependency ] [ called-dependency inlined-dependency strongest-dependency ] unit-test
+[ flushed-dependency ] [ called-dependency flushed-dependency strongest-dependency ] unit-test
+[ called-dependency ] [ called-dependency f strongest-dependency ] unit-test

core/compiler/units/units.factor

@@ -1,7 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel continuations assocs namespaces
+USING: accessors arrays kernel continuations assocs namespaces
-sequences words vocabs definitions hashtables init sets ;
+sequences words vocabs definitions hashtables init sets
+math.order classes classes.algebra ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -72,9 +73,51 @@ GENERIC: definitions-changed ( assoc obj -- )
 SYMBOL: outdated-tuples
 SYMBOL: update-tuples-hook
 
+: strongest-dependency ( how1 how2 -- how )
+    [ called-dependency or ] bi@ max ;
+
+: weakest-dependency ( how1 how2 -- how )
+    [ inlined-dependency or ] bi@ min ;
+
+: compiled-usage ( word -- assoc )
+    compiled-crossref get at ;
+
+: (compiled-usages) ( word -- assoc )
+    #! If the word is not flushable anymore, we have to recompile
+    #! all words which flushable away a call (presumably when the
+    #! word was still flushable). If the word is flushable, we
+    #! don't have to recompile words that folded this away.
+    [ compiled-usage ]
+    [ "flushable" word-prop inlined-dependency flushed-dependency ? ] bi
+    [ after=? nip ] curry assoc-filter ;
+
+: compiled-usages ( assoc -- assocs )
+    [ drop word? ] assoc-filter
+    [ [ drop (compiled-usages) ] { } assoc>map ] keep suffix ;
+
+: compiled-generic-usage ( word -- assoc )
+    compiled-generic-crossref get at ;
+
+: (compiled-generic-usages) ( generic class -- assoc )
+    dup class? [
+        [ compiled-generic-usage ] dip
+        [ [ classes-intersect? ] [ null class<= ] bi or nip ]
+        curry assoc-filter
+    ] [ 2drop f ] if ;
+
+: compiled-generic-usages ( assoc -- assocs )
+    [ (compiled-generic-usages) ] { } assoc>map ;
+
+: words-only ( assoc -- assoc' )
+    [ drop word? ] assoc-filter ;
+
+: to-recompile ( -- seq )
+    changed-definitions get compiled-usages
+    changed-generics get compiled-generic-usages
+    append assoc-combine keys ;
+
 : call-recompile-hook ( -- )
-    changed-definitions get [ drop word? ] assoc-filter
+    to-recompile recompile-hook get call ;
-    compiled-usages recompile-hook get call ;
 
 : call-update-tuples-hook ( -- )
     update-tuples-hook get call ;
@@ -93,13 +136,16 @@ SYMBOL: update-tuples-hook
 : with-nested-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-generics set
         H{ } clone outdated-tuples set
+        H{ } clone new-classes set
         [ finish-compilation-unit ] [ ] cleanup
     ] with-scope ; inline
 
 : with-compilation-unit ( quot -- )
     [
         H{ } clone changed-definitions set
+        H{ } clone changed-generics set
         H{ } clone forgotten-definitions set
         H{ } clone outdated-tuples set
         H{ } clone new-classes set

core/definitions/definitions.factor

@@ -1,17 +1,38 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: definitions
-USING: kernel sequences namespaces assocs graphs ;
+USING: kernel sequences namespaces assocs graphs math math.order ;
 
 ERROR: no-compilation-unit definition ;
 
+SINGLETON: inlined-dependency
+SINGLETON: flushed-dependency
+SINGLETON: called-dependency
+
+UNION: dependency
+inlined-dependency
+flushed-dependency
+called-dependency ;
+
+M: dependency <=>
+    [
+        {
+            called-dependency
+            flushed-dependency
+            inlined-dependency
+        } index
+    ] bi@ <=> ;
+
 SYMBOL: changed-definitions
 
-SYMBOL: +inlined+
+: changed-definition ( defspec -- )
-SYMBOL: +called+
+    inlined-dependency swap changed-definitions get
+    [ set-at ] [ no-compilation-unit ] if* ;
 
-: changed-definition ( defspec how -- )
+SYMBOL: changed-generics
-    swap changed-definitions get
+
+: changed-generic ( class generic -- )
+    changed-generics get
     [ set-at ] [ no-compilation-unit ] if* ;
 
 SYMBOL: new-classes

core/generic/generic.factor

@@ -53,22 +53,12 @@ GENERIC: next-method-quot* ( class generic combination -- quot )
 TUPLE: check-method class generic ;
 
 : check-method ( class generic -- class generic )
-    over class? over generic? and [
+    2dup [ class? ] [ generic? ] bi* and [
         \ check-method boa throw
     ] unless ; inline
 
-: affected-methods ( class generic -- seq )
-    "methods" word-prop swap
-    [ nip [ classes-intersect? ] [ class<= ] 2bi or ] curry assoc-filter
-    values ;
-
-GENERIC# update-generic 1 ( class generic -- )
-
-M: class update-generic
-    affected-methods [ +called+ changed-definition ] each ;
-
 : with-methods ( class generic quot -- )
-    [ drop update-generic ]
+    [ drop changed-generic ]
     [ [ "methods" word-prop ] dip call ]
     [ drop make-generic drop ]
     3tri ; inline
@@ -168,7 +158,7 @@ M: method-body smart-usage
 
 M: sequence update-methods ( class seq -- )
     implementors [
-        [ update-generic ] [ make-generic drop ] 2bi
+        [ changed-generic ] [ make-generic drop ] 2bi
     ] with each ;
 
 : define-generic ( word combination -- )

core/words/words.factor

@@ -101,60 +101,79 @@ SYMBOL: compiled-crossref
 
 compiled-crossref global [ H{ } assoc-like ] change-at
 
-: compiled-xref ( word dependencies -- )
+SYMBOL: compiled-generic-crossref
-    [ drop crossref? ] assoc-filter
+
-    [ "compiled-uses" set-word-prop ]
+compiled-generic-crossref global [ H{ } assoc-like ] change-at
-    [ compiled-crossref get add-vertex* ]
+
-    2bi ;
+: (compiled-xref) ( word dependencies word-prop variable -- )
+    [ [ set-word-prop ] curry ]
+    [ [ get add-vertex* ] curry ]
+    bi* 2bi ;
+
+: compiled-xref ( word dependencies generic-dependencies -- )
+    [ [ drop crossref? ] assoc-filter ] bi@
+    [ over ] dip
+    [ "compiled-uses" compiled-crossref (compiled-xref) ]
+    [ "compiled-generic-uses" compiled-generic-crossref (compiled-xref) ]
+    2bi* ;
+
+: (compiled-unxref) ( word word-prop variable -- )
+    [ [ [ dupd word-prop ] dip get remove-vertex* ] 2curry ]
+    [ drop [ f swap set-word-prop ] curry ]
+    2bi bi ;
 
 : compiled-unxref ( word -- )
-    [
+    [ "compiled-uses" compiled-crossref (compiled-unxref) ]
-        dup "compiled-uses" word-prop
+    [ "compiled-generic-uses" compiled-generic-crossref (compiled-unxref) ]
-        compiled-crossref get remove-vertex*
+    bi ;
-    ]
-    [ f "compiled-uses" set-word-prop ] bi ;
 
 : delete-compiled-xref ( word -- )
-    dup compiled-unxref
+    [ compiled-unxref ]
-    compiled-crossref get delete-at ;
+    [ compiled-crossref get delete-at ]
+    [ compiled-generic-crossref get delete-at ]
+    tri ;
 
-: compiled-usage ( word -- assoc )
+GENERIC: inline? ( word -- ? )
-    compiled-crossref get at ;
 
-: compiled-usages ( assoc -- seq )
+M: word inline? "inline" word-prop ;
-    clone [
+
-        dup [
+SYMBOL: visited
+
+: reset-on-redefine { "inferred-effect" "cannot-infer" } ; inline
+
+: (redefined) ( word -- )
+    dup visited get key? [ drop ] [
+        [ reset-on-redefine reset-props ]
+        [ visited get conjoin ]
         [
-                [ compiled-usage ] dip
+            crossref get at keys
-                +inlined+ eq? [
+            [ word? ] filter
-                    [ nip +inlined+ eq? ] assoc-filter
+            [
-                ] when
+                [ reset-on-redefine [ word-prop ] with contains? ]
-            ] dip swap update
+                [ inline? ]
-        ] curry assoc-each
+                bi or
-    ] keep keys ;
+            ] filter
+            [ (redefined) ] each
+        ] tri
+    ] if ;
 
-GENERIC: redefined ( word -- )
+: redefined ( word -- )
-
+    [ H{ } clone visited [ (redefined) ] with-variable ]
-M: object redefined drop ;
+    [ changed-definition ]
+    bi ;
 
 : define ( word def -- )
     [ ] like
     over unxref
     over redefined
     >>def
-    dup +inlined+ changed-definition
     dup crossref? [ dup xref ] when drop ;
 
 : set-stack-effect ( effect word -- )
     2dup "declared-effect" word-prop = [ 2drop ] [
         swap
         [ "declared-effect" set-word-prop ]
-        [
+        [ drop dup primitive? [ dup redefined ] unless drop ] 2bi
-            drop
-            dup primitive? [ drop ] [
-                [ redefined ] [ +inlined+ changed-definition ] bi
-            ] if
-        ] 2bi
     ] if ;
 
 : define-declared ( word def effect -- )
@@ -226,10 +245,6 @@ ERROR: bad-create name vocab ;
 : constructor-word ( name vocab -- word )
     >r "<" swap ">" 3append r> create ;
 
-GENERIC: inline? ( word -- ? )
-
-M: word inline? "inline" word-prop ;
-
 PREDICATE: parsing-word < word "parsing" word-prop ;
 
 : delimiter? ( obj -- ? )

extra/classes/tuple/lib/lib.factor

@@ -1,11 +1,11 @@
 ! Copyright (C) 2007 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel macros sequences slots words classes.tuple
-quotations combinators ;
+quotations combinators accessors ;
 IN: classes.tuple.lib
 
 : reader-slots ( seq -- quot )
-    [ slot-spec-reader 1quotation ] map [ cleave ] curry ;
+    [ reader>> 1quotation ] map [ cleave ] curry ;
 
 MACRO: >tuple< ( class -- )
     all-slots rest-slice reader-slots ;

extra/fjsc/fjsc.factor

@@ -353,11 +353,11 @@ M: quotation fjsc-parse ( object -- ast )
   ] with-string-writer ;
 
 : fjsc-compile* ( string -- string )
-  'statement' parse parse-result-ast fjsc-compile ;
+  'statement' parse ast>> fjsc-compile ;
 
 : fc* ( string -- string )
   [
-  'statement' parse parse-result-ast values>> do-expressions
+  'statement' parse ast>> values>> do-expressions
   ] { } make [ write ] each ;
 
 

extra/inverse/inverse.factor

@@ -208,7 +208,7 @@ DEFER: _
 
 : slot-readers ( class -- quot )
     all-slots rest ! tail gets rid of delegate
-    [ slot-spec-reader 1quotation [ keep ] curry ] map concat
+    [ reader>> 1quotation [ keep ] curry ] map concat
     [ ] like [ drop ] compose ;
 
 : ?wrapped ( object -- wrapped )

extra/json/reader/reader.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel parser-combinators namespaces sequences promises strings 
        assocs math math.parser math.vectors math.functions math.order
-       lists hashtables ascii ;
+       lists hashtables ascii accessors ;
 IN: json.reader
 
 ! Grammar for JSON from RFC 4627
@@ -169,11 +169,12 @@ LAZY: 'value' ( -- parser )
     'array' ,
     'number' ,
   ] [<|>] spaced ;
+ERROR: could-not-parse-json ;
 
 : json> ( string -- object )
   #! Parse a json formatted string to a factor object
   'value' parse dup nil? [ 
-    "Could not parse json" throw
+      could-not-parse-json
   ] [ 
-    car parse-result-parsed 
+    car parsed>> 
   ] if ;

extra/lists/lazy/lazy.factor

@@ -24,7 +24,7 @@ TUPLE: lazy-cons car cdr ;
 : lazy-cons ( car cdr -- promise )
     [ promise ] bi@ \ lazy-cons boa
     T{ promise f f t f } clone
-    [ set-promise-value ] keep ;
+        swap >>value ;
 
 M: lazy-cons car ( lazy-cons -- car )
     car>> force ;

extra/morse/morse.factor

@@ -116,7 +116,7 @@ LAZY: 'morse-words' ( -- parser )
 PRIVATE>
 
 : morse> ( str -- str )
-    'morse-words' parse car parse-result-parsed [
+    'morse-words' parse car parsed>> [
         [ 
             >string morse>ch
         ] map >string

extra/nehe/4/4.factor

@@ -1,5 +1,5 @@
 USING: arrays kernel math opengl opengl.gl opengl.glu ui
-ui.gadgets ui.render threads ;
+ui.gadgets ui.render threads accessors ;
 IN: nehe.4
 
 TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
@@ -10,8 +10,8 @@ TUPLE: nehe4-gadget < gadget rtri rquad thread quit? ;
 
 : <nehe4-gadget> (  -- gadget )
   nehe4-gadget new-gadget
-  0.0 over set-nehe4-gadget-rtri
+    0.0 >>rtri
-  0.0 over set-nehe4-gadget-rquad ;
+    0.0 >>rquad ;
 
 M: nehe4-gadget pref-dim* ( gadget -- dim )
   drop width height 2array ;
@@ -53,22 +53,22 @@ M: nehe4-gadget draw-gadget* ( gadget -- )
     1.0 -1.0 0.0 glVertex3f
     -1.0 -1.0 0.0 glVertex3f
   ] do-state
-  dup nehe4-gadget-rtri 0.2 + over set-nehe4-gadget-rtri
+  [ 0.2 + ] change-rtri
-  dup nehe4-gadget-rquad 0.15 - swap set-nehe4-gadget-rquad ;
+  [ 0.15 - ] change-rquad drop ;
 
 : nehe4-update-thread ( gadget -- )
-  dup nehe4-gadget-quit? [ drop ] [
+  dup quit?>> [ drop ] [
     redraw-interval sleep
     dup relayout-1
     nehe4-update-thread
   ] if ;
 
 M: nehe4-gadget graft* ( gadget -- )
-  [ f swap set-nehe4-gadget-quit? ] keep
+  f >>quit?
   [ nehe4-update-thread ] in-thread drop ;
 
 M: nehe4-gadget ungraft* ( gadget -- )
-  t swap set-nehe4-gadget-quit? ;
+  t >>quit? drop ;
 
 : run4 ( -- )
   <nehe4-gadget> "NeHe Tutorial 4" open-window ;

extra/nehe/5/5.factor

@@ -1,5 +1,5 @@
 USING: arrays kernel math opengl opengl.gl opengl.glu ui
-ui.gadgets ui.render threads ;
+ui.gadgets ui.render threads accessors ;
 IN: nehe.5
 
 TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
@@ -9,8 +9,8 @@ TUPLE: nehe5-gadget < gadget rtri rquad thread quit? ;
 
 : <nehe5-gadget> (  -- gadget )
   nehe5-gadget new-gadget
-  0.0 over set-nehe5-gadget-rtri
+    0.0 >>rtri
-  0.0 over set-nehe5-gadget-rquad ;
+    0.0 >>rquad ;
 
 M: nehe5-gadget pref-dim* ( gadget -- dim )
   drop width height 2array ;
@@ -103,11 +103,11 @@ M: nehe5-gadget draw-gadget* ( gadget -- )
     1.0 -1.0 1.0 glVertex3f
     1.0 -1.0 -1.0 glVertex3f
   ] do-state 
-  dup nehe5-gadget-rtri 0.2 + over set-nehe5-gadget-rtri
+  [ 0.2 + ] change-rtri
-  dup nehe5-gadget-rquad 0.15 - swap set-nehe5-gadget-rquad ;
+  [ 0.15 - ] change-rquad drop ;
 
 : nehe5-update-thread ( gadget -- )  
-  dup nehe5-gadget-quit? [
+  dup quit?>> [
     drop
   ] [
     redraw-interval sleep 
@@ -116,11 +116,11 @@ M: nehe5-gadget draw-gadget* ( gadget -- )
   ] if ;
 
 M: nehe5-gadget graft* ( gadget -- )
- [ f swap set-nehe5-gadget-quit? ] keep
+  f >>quit?
   [ nehe5-update-thread ] in-thread drop ;
 
 M: nehe5-gadget ungraft* ( gadget -- )
- t swap set-nehe5-gadget-quit? ;
+  t >>quit? drop ;
 
 
 : run5 ( -- )

extra/ori/ori.factor

@@ -1,5 +1,5 @@
 
-USING: kernel namespaces
+USING: kernel namespaces accessors
        math math.constants math.functions math.matrices math.vectors
        sequences splitting grouping self math.trig ;
 
@@ -11,9 +11,9 @@ C: <ori> ori
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: ori> ( -- val ) self> ori-val ;
+: ori> ( -- val ) self> val>> ;
 
-: >ori ( val -- ) self> set-ori-val ;
+: >ori ( val -- ) self> (>>val) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 

extra/parser-combinators/parser-combinators.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: lists lists.lazy promises kernel sequences strings math
 arrays splitting quotations combinators namespaces
-unicode.case unicode.categories sequences.deep ;
+unicode.case unicode.categories sequences.deep accessors ;
 IN: parser-combinators
 
 ! Parser combinator protocol
@@ -13,11 +13,13 @@ M: promise parse ( input parser -- list )
 
 TUPLE: parse-result parsed unparsed ;
 
+ERROR: cannot-parse input ;
+
 : parse-1 ( input parser -- result )
     dupd parse dup nil? [
-        "Cannot parse " rot append throw
+        rot cannot-parse
     ] [
-        nip car parse-result-parsed
+        nip car parsed>>
     ] if ;
 
 C: <parse-result> parse-result
@@ -26,12 +28,12 @@ C: <parse-result> parse-result
     <parse-result> 1list ;
 
 : parse-result-parsed-slice ( parse-result -- slice )
-    dup parse-result-parsed empty? [
+    dup parsed>> empty? [
-        parse-result-unparsed 0 0 rot <slice>
+        unparsed>> 0 0 rot <slice>
     ] [
-        dup parse-result-unparsed
+        dup unparsed>>
-        dup slice-from [ rot parse-result-parsed length - ] keep
+        dup from>> [ rot parsed>> length - ] keep
-        rot slice-seq <slice>
+        rot seq>> <slice>
     ] if ;
 
 : string= ( str1 str2 ignore-case -- ? )
@@ -132,7 +134,7 @@ TUPLE: and-parser parsers ;
 
 : <&> ( parser1 parser2 -- parser )
     over and-parser? [
-        >r and-parser-parsers r> suffix
+        >r parsers>> r> suffix
     ] [
         2array
     ] if and-parser boa ;
@@ -142,11 +144,11 @@ TUPLE: and-parser parsers ;
 
 : and-parser-parse ( list p1  -- list )
     swap [
-        dup parse-result-unparsed rot parse
+        dup unparsed>> rot parse
         [
-            >r parse-result-parsed r>
+            >r parsed>> r>
-            [ parse-result-parsed 2array ] keep
+            [ parsed>> 2array ] keep
-            parse-result-unparsed <parse-result>
+            unparsed>> <parse-result>
         ] lazy-map-with
     ] lazy-map-with lconcat ;
 

extra/peg/ebnf/ebnf.factor

@@ -508,10 +508,10 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
 
 : check-parse-result ( result -- result )
   dup [
-    dup parse-result-remaining [ blank? ] trim empty? [
+    dup remaining>> [ blank? ] trim empty? [
       [ 
         "Unable to fully parse EBNF. Left to parse was: " %
-        parse-result-remaining % 
+        remaining>> % 
       ] "" make throw
     ] unless
   ] [

extra/pos/pos.factor

@@ -1,5 +1,6 @@
 
-USING: kernel math math.functions math.vectors sequences self ;
+USING: kernel math math.functions math.vectors sequences self
+accessors ;
 
 IN: pos
 
@@ -9,13 +10,13 @@ TUPLE: pos val ;
 
 C: <pos> pos
 
-: pos> ( -- val ) self> pos-val ;
+: pos> ( -- val ) self> val>> ;
 
-: >pos ( val -- ) self> set-pos-val ;
+: >pos ( val -- ) self> (>>val) ;
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: distance ( pos pos -- n ) pos-val swap pos-val v- [ sq ] map sum sqrt ;
+: distance ( pos pos -- n ) val>> swap val>> v- [ sq ] map sum sqrt ;
 
 : move-by ( point -- ) pos> v+ >pos ;
 

extra/regexp/regexp.factor

@@ -270,14 +270,14 @@ TUPLE: regexp source parser ignore-case? ;
     ] keep regexp boa ;
 
 : do-ignore-case ( string regexp -- string regexp )
-    dup regexp-ignore-case? [ >r >upper r> ] when ;
+    dup ignore-case?>> [ >r >upper r> ] when ;
 
 : matches? ( string regexp -- ? )
-    do-ignore-case regexp-parser just parse nil? not ;
+    do-ignore-case parser>> just parse nil? not ;
 
 : match-head ( string regexp -- end )
-    do-ignore-case regexp-parser parse dup nil?
+    do-ignore-case parser>> parse dup nil?
-    [ drop f ] [ car parse-result-unparsed from>> ] if ;
+    [ drop f ] [ car unparsed>> from>> ] if ;
 
 ! Literal syntax for regexps
 : parse-options ( string -- ? )

extra/state-machine/state-machine.factor

@@ -1,5 +1,6 @@
-USING: kernel parser lexer strings math namespaces sequences words io
+USING: kernel parser lexer strings math namespaces
-arrays quotations debugger kernel.private sequences.private ;
+sequences words io arrays quotations debugger accessors
+sequences.private ;
 IN: state-machine
 
 : STATES:
@@ -20,9 +21,9 @@ M: missing-state error.
     ! quot is ( state string -- output-string )
     [ missing-state ] <array> dup
     [
-        [ >r dup dup state-data swap state-place r> ] %
+        [ >r dup [ data>> ] [ place>> ] bi r> ] %
         [ swapd bounds-check dispatch ] curry ,
-        [ each pick set-state-place swap set-state-data ] %
+        [ each pick (>>place) swap (>>date) ] %
     ] [ ] make [ over make ] curry ;
 
 : define-machine ( word state-class -- )

extra/turing/turing.factor

@@ -1,6 +1,6 @@
-IN: turing
 USING: arrays assocs io kernel math namespaces
-prettyprint sequences strings vectors words ;
+prettyprint sequences strings vectors words accessors ;
+IN: turing
 
 ! A turing machine simulator.
 
@@ -55,9 +55,9 @@ SYMBOL: tape
 : turing-step ( -- )
     #! Do one step of the turing machine.
     next-state
-    dup state-sym set-sym
+    dup sym>> set-sym
-    dup state-dir position [ + ] change
+    dup dir>> position [ + ] change
-    state-next state set ;
+    next>> state set ;
 
 : c ( -- )
     #! Print current turing machine state.