Removing old accessor usages from core and basis

diff --git a/basis/alien/arrays/arrays.factor b/basis/alien/arrays/arrays.factor
index 0f756e0ad07eeaeab6eb57d1e0c3d433ab32b670..71c3fd6ff2bf53cd7b4146ddd429952e626820a6 100644 (file)
--- a/basis/alien/arrays/arrays.factor
+++ b/basis/alien/arrays/arrays.factor
@@ -10,7 +10,7 @@ M: array c-type ;
 
 M: array heap-size unclip heap-size [ * ] reduce ;
 
-M: array c-type-align first c-type c-type-align ;
+M: array c-type-align first c-type-align ;
 
 M: array c-type-stack-align? drop f ;
 

diff --git a/basis/alien/c-types/c-types.factor b/basis/alien/c-types/c-types.factor
index a9b39f80abe10c3c81e9b761269d89a83848846e..f44941d88f1ca66a38ee04d403904ee5e3de7e93 100755 (executable)
--- a/basis/alien/c-types/c-types.factor
+++ b/basis/alien/c-types/c-types.factor
@@ -37,6 +37,7 @@ ERROR: no-c-type name ;
         dup string? [ (c-type) ] when
     ] when ;
 
+! C type protocol
 GENERIC: c-type ( name -- type ) foldable
 
 : resolve-pointer-type ( name -- name )
@@ -62,6 +63,60 @@ M: string c-type ( name -- type )
         ] ?if
     ] if ;
 
+GENERIC: c-type-boxer ( name -- boxer )
+
+M: c-type c-type-boxer boxer>> ;
+
+M: string c-type-boxer c-type c-type-boxer ;
+
+GENERIC: c-type-boxer-quot ( name -- quot )
+
+M: c-type c-type-boxer-quot boxer-quot>> ;
+
+M: string c-type-boxer-quot c-type c-type-boxer-quot ;
+
+GENERIC: c-type-unboxer ( name -- boxer )
+
+M: c-type c-type-unboxer unboxer>> ;
+
+M: string c-type-unboxer c-type c-type-unboxer ;
+
+GENERIC: c-type-unboxer-quot ( name -- quot )
+
+M: c-type c-type-unboxer-quot unboxer-quot>> ;
+
+M: string c-type-unboxer-quot c-type c-type-unboxer-quot ;
+
+GENERIC: c-type-reg-class ( name -- reg-class )
+
+M: c-type c-type-reg-class reg-class>> ;
+
+M: string c-type-reg-class c-type c-type-reg-class ;
+
+GENERIC: c-type-getter ( name -- quot )
+
+M: c-type c-type-getter getter>> ;
+
+M: string c-type-getter c-type c-type-getter ;
+
+GENERIC: c-type-setter ( name -- quot )
+
+M: c-type c-type-setter setter>> ;
+
+M: string c-type-setter c-type c-type-setter ;
+
+GENERIC: c-type-align ( name -- n )
+
+M: c-type c-type-align align>> ;
+
+M: string c-type-align c-type c-type-align ;
+
+GENERIC: c-type-stack-align? ( name -- ? )
+
+M: c-type c-type-stack-align? stack-align?>> ;
+
+M: string c-type-stack-align? c-type c-type-stack-align? ;
+
 : c-type-box ( n type -- )
     dup c-type-reg-class
     swap c-type-boxer [ "No boxer" throw ] unless*
@@ -72,10 +127,6 @@ M: string c-type ( name -- type )
     swap c-type-unboxer [ "No unboxer" throw ] unless*
     %unbox ;
 
-M: string c-type-align c-type c-type-align ;
-
-M: string c-type-stack-align? c-type c-type-stack-align? ;
-
 GENERIC: box-parameter ( n ctype -- )
 
 M: c-type box-parameter c-type-box ;
@@ -107,25 +158,25 @@ GENERIC: heap-size ( type -- size ) foldable
 
 M: string heap-size c-type heap-size ;
 
-M: c-type heap-size c-type-size ;
+M: c-type heap-size size>> ;
 
 GENERIC: stack-size ( type -- size ) foldable
 
 M: string stack-size c-type stack-size ;
 
-M: c-type stack-size c-type-size ;
+M: c-type stack-size size>> ;
 
 GENERIC: byte-length ( seq -- n ) flushable
 
 M: byte-array byte-length length ;
 
 : c-getter ( name -- quot )
-    c-type c-type-getter [
+    c-type-getter [
         [ "Cannot read struct fields with type" throw ]
     ] unless* ;
 
 : c-setter ( name -- quot )
-    c-type c-type-setter [
+    c-type-setter [
         [ "Cannot write struct fields with type" throw ]
     ] unless* ;
 

diff --git a/basis/alien/structs/structs-docs.factor b/basis/alien/structs/structs-docs.factor
index 2c464cc74c39e784e9a59f26f2d85edae6eff526..6f83885d9f826b0762bfb4ebb5c3ce7d6a94829f 100755 (executable)
--- a/basis/alien/structs/structs-docs.factor
+++ b/basis/alien/structs/structs-docs.factor
@@ -1,5 +1,5 @@
 IN: alien.structs
-USING: alien.c-types strings help.markup help.syntax
+USING: accessors alien.c-types strings help.markup help.syntax
 alien.syntax sequences io arrays slots.deprecated
 kernel words slots assocs namespaces accessors ;
 
@@ -67,7 +67,7 @@ M: word slot-specs "slots" word-prop ;
     first dup "writing" word-prop [ slot-specs ] keep
     $spec-writer ;
 
-M: string slot-specs c-type struct-type-fields ;
+M: string slot-specs c-type fields>> ;
 
 M: array ($instance) first ($instance) " array" write ;
 

diff --git a/basis/alien/structs/structs-tests.factor b/basis/alien/structs/structs-tests.factor
index bfdcd31b99ec74cc6c3f1366bae60adb80d8519f..8c7d9f9b29daadaffeb01beede959617e377a848 100644 (file)
--- a/basis/alien/structs/structs-tests.factor
+++ b/basis/alien/structs/structs-tests.factor
@@ -7,7 +7,7 @@ C-STRUCT: bar
     { { "int" 8 } "y" } ;
 
 [ 36 ] [ "bar" heap-size ] unit-test
-[ t ] [ \ <displaced-alien> "bar" c-type c-type-getter memq? ] unit-test
+[ t ] [ \ <displaced-alien> "bar" c-type-getter memq? ] unit-test
 
 C-STRUCT: align-test
     { "int" "x" }

diff --git a/basis/alien/structs/structs.factor b/basis/alien/structs/structs.factor
index 51283e29565ebed19409998c36dd011d259ad5f9..e6a363941de9c3909c8e03f6ce6bcac0b26ec2f7 100755 (executable)
--- a/basis/alien/structs/structs.factor
+++ b/basis/alien/structs/structs.factor
@@ -6,7 +6,7 @@ slots.deprecated alien.c-types cpu.architecture ;
 IN: alien.structs
 
 : align-offset ( offset type -- offset )
-    c-type c-type-align align ;
+    c-type-align align ;
 
 : struct-offsets ( specs -- size )
     0 [
@@ -24,7 +24,7 @@ IN: alien.structs
     [ reader>> ]
     [
         class>>
-        [ c-getter ] [ c-type c-type-boxer-quot ] bi append
+        [ c-getter ] [ c-type-boxer-quot ] bi append
     ] tri
     define-struct-slot-word ;
 
@@ -44,9 +44,9 @@ IN: alien.structs
 
 TUPLE: struct-type size align fields ;
 
-M: struct-type heap-size struct-type-size ;
+M: struct-type heap-size size>> ;
 
-M: struct-type c-type-align struct-type-align ;
+M: struct-type c-type-align align>> ;
 
 M: struct-type c-type-stack-align? drop f ;
 

diff --git a/basis/bootstrap/stage2.factor b/basis/bootstrap/stage2.factor
index 08da2ae14b3d95ca1259a1412a77cca3f88a72f9..2388d7b8f0cf9e11718edba424ca02e6cb50106b 100755 (executable)
--- a/basis/bootstrap/stage2.factor
+++ b/basis/bootstrap/stage2.factor
@@ -1,11 +1,11 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors init command-line namespaces words debugger io
+USING: accessors init namespaces words io
 kernel.private math memory continuations kernel io.files
 io.backend system parser vocabs sequences prettyprint
 vocabs.loader combinators splitting source-files strings
 definitions assocs compiler.errors compiler.units
-math.parser generic sets ;
+math.parser generic sets debugger command-line ;
 IN: bootstrap.stage2
 
 SYMBOL: bootstrap-time

diff --git a/basis/compiler/generator/registers/registers.factor b/basis/compiler/generator/registers/registers.factor
index 2452b19e1144d5ffb6bede47955b6dc4bcda3832..e460f5558b610380e37272b33176e9127a3fc1c9 100755 (executable)
--- a/basis/compiler/generator/registers/registers.factor
+++ b/basis/compiler/generator/registers/registers.factor
@@ -69,23 +69,21 @@ TUPLE: ds-loc n class ;
 
 : <ds-loc> ( n -- loc ) f ds-loc boa ;
 
-M: ds-loc minimal-ds-loc* ds-loc-n min ;
-M: ds-loc operand-class* ds-loc-class ;
-M: ds-loc set-operand-class set-ds-loc-class ;
+M: ds-loc minimal-ds-loc* n>> min ;
 M: ds-loc live-loc?
-    over ds-loc? [ [ ds-loc-n ] bi@ = not ] [ 2drop t ] if ;
+    over ds-loc? [ [ n>> ] bi@ = not ] [ 2drop t ] if ;
 
 ! A retain stack location.
 TUPLE: rs-loc n class ;
 
 : <rs-loc> ( n -- loc ) f rs-loc boa ;
-M: rs-loc operand-class* rs-loc-class ;
-M: rs-loc set-operand-class set-rs-loc-class ;
 M: rs-loc live-loc?
-    over rs-loc? [ [ rs-loc-n ] bi@ = not ] [ 2drop t ] if ;
+    over rs-loc? [ [ n>> ] bi@ = not ] [ 2drop t ] if ;
 
 UNION: loc ds-loc rs-loc ;
 
+M: loc operand-class* class>> ;
+M: loc set-operand-class (>>class) ;
 M: loc move-spec drop loc ;
 
 INSTANCE: loc value
@@ -106,12 +104,12 @@ M: cached set-operand-class vreg>> set-operand-class ;
 M: cached operand-class* vreg>> operand-class* ;
 M: cached move-spec drop cached ;
 M: cached live-vregs* vreg>> live-vregs* ;
-M: cached live-loc? cached-loc live-loc? ;
+M: cached live-loc? loc>> live-loc? ;
 M: cached (lazy-load) >r vreg>> r> (lazy-load) ;
 M: cached lazy-store
-    2dup cached-loc live-loc?
+    2dup loc>> live-loc?
     [ "live-locs" get at %move ] [ 2drop ] if ;
-M: cached minimal-ds-loc* cached-loc minimal-ds-loc* ;
+M: cached minimal-ds-loc* loc>> minimal-ds-loc* ;
 
 INSTANCE: cached value
 
@@ -121,48 +119,48 @@ TUPLE: tagged vreg class ;
 : <tagged> ( vreg -- tagged )
     f tagged boa ;
 
-M: tagged v>operand tagged-vreg v>operand ;
-M: tagged set-operand-class set-tagged-class ;
-M: tagged operand-class* tagged-class ;
+M: tagged v>operand vreg>> v>operand ;
+M: tagged set-operand-class (>>class) ;
+M: tagged operand-class* class>> ;
 M: tagged move-spec drop f ;
-M: tagged live-vregs* tagged-vreg , ;
+M: tagged live-vregs* vreg>> , ;
 
 INSTANCE: tagged value
 
 ! Unboxed alien pointers
 TUPLE: unboxed-alien vreg ;
 C: <unboxed-alien> unboxed-alien
-M: unboxed-alien v>operand unboxed-alien-vreg v>operand ;
+M: unboxed-alien v>operand vreg>> v>operand ;
 M: unboxed-alien operand-class* drop simple-alien ;
 M: unboxed-alien move-spec class ;
-M: unboxed-alien live-vregs* unboxed-alien-vreg , ;
+M: unboxed-alien live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-alien value
 
 TUPLE: unboxed-byte-array vreg ;
 C: <unboxed-byte-array> unboxed-byte-array
-M: unboxed-byte-array v>operand unboxed-byte-array-vreg v>operand ;
+M: unboxed-byte-array v>operand vreg>> v>operand ;
 M: unboxed-byte-array operand-class* drop c-ptr ;
 M: unboxed-byte-array move-spec class ;
-M: unboxed-byte-array live-vregs* unboxed-byte-array-vreg , ;
+M: unboxed-byte-array live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-byte-array value
 
 TUPLE: unboxed-f vreg ;
 C: <unboxed-f> unboxed-f
-M: unboxed-f v>operand unboxed-f-vreg v>operand ;
+M: unboxed-f v>operand vreg>> v>operand ;
 M: unboxed-f operand-class* drop \ f ;
 M: unboxed-f move-spec class ;
-M: unboxed-f live-vregs* unboxed-f-vreg , ;
+M: unboxed-f live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-f value
 
 TUPLE: unboxed-c-ptr vreg ;
 C: <unboxed-c-ptr> unboxed-c-ptr
-M: unboxed-c-ptr v>operand unboxed-c-ptr-vreg v>operand ;
+M: unboxed-c-ptr v>operand vreg>> v>operand ;
 M: unboxed-c-ptr operand-class* drop c-ptr ;
 M: unboxed-c-ptr move-spec class ;
-M: unboxed-c-ptr live-vregs* unboxed-c-ptr-vreg , ;
+M: unboxed-c-ptr live-vregs* vreg>> , ;
 
 INSTANCE: unboxed-c-ptr value
 

diff --git a/basis/cpu/ppc/architecture/architecture.factor b/basis/cpu/ppc/architecture/architecture.factor
index 0b570907ab05c107541bcfc621dd483d7460f2f7..00bdb4b7c9c840abd546e11b3c18dcb60e1547d9 100755 (executable)
--- a/basis/cpu/ppc/architecture/architecture.factor
+++ b/basis/cpu/ppc/architecture/architecture.factor
@@ -1,10 +1,11 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien.c-types cpu.ppc.assembler cpu.architecture generic
-kernel kernel.private math memory namespaces sequences words
-assocs compiler.generator compiler.generator.registers
-compiler.generator.fixup system layouts classes words.private
-alien combinators compiler.constants math.order ;
+USING: accessors alien.c-types cpu.ppc.assembler
+cpu.architecture generic kernel kernel.private math memory
+namespaces sequences words assocs compiler.generator
+compiler.generator.registers compiler.generator.fixup system
+layouts classes words.private alien combinators
+compiler.constants math.order ;
 IN: cpu.ppc.architecture
 
 ! PowerPC register assignments
@@ -65,8 +66,8 @@ M: float-regs vregs drop { 0 1 2 3 4 5 6 7 8 9 10 11 12 13 } ;
 
 GENERIC: loc>operand ( loc -- reg n )
 
-M: ds-loc loc>operand ds-loc-n cells neg ds-reg swap ;
-M: rs-loc loc>operand rs-loc-n cells neg rs-reg swap ;
+M: ds-loc loc>operand n>> cells neg ds-reg swap ;
+M: rs-loc loc>operand n>> cells neg rs-reg swap ;
 
 M: immediate load-literal
     [ v>operand ] bi@ LOAD ;

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index eede86085b112f44246f3eb6dc1898d7c55f309c..157794511828dc93f37ac4e333f510e83635dd89 100755 (executable)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -1,14 +1,15 @@
-USING: cpu.ppc.architecture cpu.ppc.intrinsics cpu.architecture
-namespaces alien.c-types kernel system combinators ;
+USING: accessors cpu.ppc.architecture cpu.ppc.intrinsics
+cpu.architecture namespaces alien.c-types kernel system
+combinators ;
 
 {
     { [ os macosx? ] [
-        4 "longlong" c-type set-c-type-align
-        4 "ulonglong" c-type set-c-type-align
-        4 "double" c-type set-c-type-align
+        4 "longlong" c-type (>>align)
+        4 "ulonglong" c-type (>>align)
+        4 "double" c-type (>>align)
     ] }
     { [ os linux? ] [
-        t "longlong" c-type set-c-type-stack-align?
-        t "ulonglong" c-type set-c-type-stack-align?
+        t "longlong" c-type (>>stack-align?)
+        t "ulonglong" c-type (>>stack-align?)
     ] }
 } cond

diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor
index 504707777af0dbd5948b627b0492cff5e3bac6c1..6f255893db088d6dc38d10917df22f1a92bfe49f 100755 (executable)
--- a/basis/cpu/x86/32/32.factor
+++ b/basis/cpu/x86/32/32.factor
@@ -259,9 +259,9 @@ M: x86.32 %cleanup ( alien-node -- )
 M: x86.32 %unwind ( n -- ) %epilogue-later RET ;
 
 os windows? [
-    cell "longlong" c-type set-c-type-align
-    cell "ulonglong" c-type set-c-type-align
-    4 "double" c-type set-c-type-align
+    cell "longlong" c-type (>>align)
+    cell "ulonglong" c-type (>>align)
+    4 "double" c-type (>>align)
 ] unless
 
 : (sse2?) ( -- ? ) "Intrinsic" throw ;

diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor
index 0ba3b9373097682af20c96f93e8865afba9acbb7..c1697f1d985a3ab18ec83ce67327c9b96c0f9595 100755 (executable)
--- a/basis/cpu/x86/64/64.factor
+++ b/basis/cpu/x86/64/64.factor
@@ -174,10 +174,10 @@ USE: cpu.x86.intrinsics
 
 ! The ABI for passing structs by value is pretty messed up
 << "void*" c-type clone "__stack_value" define-primitive-type
-stack-params "__stack_value" c-type set-c-type-reg-class >>
+stack-params "__stack_value" c-type (>>reg-class) >>
 
 : struct-types&offset ( struct-type -- pairs )
-    struct-type-fields [
+    fields>> [
         [ class>> ] [ offset>> ] bi 2array
     ] map ;
 

diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor
index 52ad68baf12a59010ee48c9cb454b004696d846c..69bc685364d18994aeb1ab330810e44ba273a39f 100755 (executable)
--- a/basis/cpu/x86/architecture/architecture.factor
+++ b/basis/cpu/x86/architecture/architecture.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types arrays cpu.x86.assembler
+USING: accessors alien alien.c-types arrays cpu.x86.assembler
 cpu.x86.assembler.private cpu.architecture kernel kernel.private
 math memory namespaces sequences words compiler.generator
 compiler.generator.registers compiler.generator.fixup system
@@ -16,8 +16,8 @@ HOOK: stack-save-reg cpu ( -- reg )
 
 : reg-stack ( n reg -- op ) swap cells neg [+] ;
 
-M: ds-loc v>operand ds-loc-n ds-reg reg-stack ;
-M: rs-loc v>operand rs-loc-n rs-reg reg-stack ;
+M: ds-loc v>operand n>> ds-reg reg-stack ;
+M: rs-loc v>operand n>> rs-reg reg-stack ;
 
 M: int-regs %save-param-reg drop >r stack@ r> MOV ;
 M: int-regs %load-param-reg drop swap stack@ MOV ;

diff --git a/basis/debugger/debugger.factor b/basis/debugger/debugger.factor
index 51ef806ebe04e4f7716be486d9b6a2b26a1749c4..06c410c0e44a0c2db8a4a10dcea5b2d53cbb3362 100755 (executable)
--- a/basis/debugger/debugger.factor
+++ b/basis/debugger/debugger.factor
@@ -207,7 +207,7 @@ M: no-case summary
 
 M: slice-error error.
     "Cannot create slice because " write
-    slice-error-reason print ;
+    reason>> print ;
 
 M: bounds-error summary drop "Sequence index out of bounds" ;
 
@@ -232,14 +232,14 @@ M: immutable summary drop "Sequence is immutable" ;
 
 M: redefine-error error.
     "Re-definition of " write
-    redefine-error-def . ;
+    def>> . ;
 
 M: undefined summary
     drop "Calling a deferred word before it has been defined" ;
 
 M: no-compilation-unit error.
     "Attempting to define " write
-    no-compilation-unit-definition pprint
+    definition>> pprint
     " outside of a compilation unit" print ;
 
 M: no-vocab summary
@@ -299,9 +299,9 @@ M: string expected>string ;
 
 M: unexpected error.
     "Expected " write
-    dup unexpected-want expected>string write
+    dup want>> expected>string write
     " but got " write
-    unexpected-got expected>string print ;
+    got>> expected>string print ;
 
 M: lexer-error error.
     [ lexer-dump ] [ error>> error. ] bi ;

diff --git a/basis/help/definitions/definitions.factor b/basis/help/definitions/definitions.factor
index 4d942ae3a989aa434d380b7db9a949dffb21b9c5..e5202e13064b0bdbc2b397516351cb3b531f4804 100755 (executable)
--- a/basis/help/definitions/definitions.factor
+++ b/basis/help/definitions/definitions.factor
@@ -1,6 +1,6 @@
-! Copyright (C) 2007 Slava Pestov.
+! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: definitions help help.topics help.syntax
+USING: accessors definitions help help.topics help.syntax
 prettyprint.backend prettyprint words kernel effects ;
 IN: help.definitions
 
@@ -8,30 +8,30 @@ IN: help.definitions
 
 M: link definer drop \ ARTICLE: \ ; ;
 
-M: link where link-name article article-loc ;
+M: link where name>> article loc>> ;
 
-M: link set-where link-name article set-article-loc ;
+M: link set-where name>> article (>>loc) ;
 
-M: link forget* link-name remove-article ;
+M: link forget* name>> remove-article ;
 
 M: link definition article-content ;
 
 M: link synopsis*
     dup definer.
-    dup link-name pprint*
+    dup name>> pprint*
     article-title pprint* ;
 
 M: word-link definer drop \ HELP: \ ; ;
 
-M: word-link where link-name "help-loc" word-prop ;
+M: word-link where name>> "help-loc" word-prop ;
 
-M: word-link set-where link-name swap "help-loc" set-word-prop ;
+M: word-link set-where name>> swap "help-loc" set-word-prop ;
 
-M: word-link definition link-name "help" word-prop ;
+M: word-link definition name>> "help" word-prop ;
 
 M: word-link synopsis*
     dup definer.
-    link-name dup pprint-word
+    name>> dup pprint-word
     stack-effect. ;
 
-M: word-link forget* link-name remove-word-help ;
+M: word-link forget* name>> remove-word-help ;

diff --git a/basis/help/syntax/syntax.factor b/basis/help/syntax/syntax.factor
index 65120a5d01b977e57fc421c47744e04e861b0ca3..42d5ba1781e7cf2229d15a8f944f16bf1cd9b000 100755 (executable)
--- a/basis/help/syntax/syntax.factor
+++ b/basis/help/syntax/syntax.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel parser sequences words help help.topics
-namespaces vocabs definitions compiler.units ;
+USING: accessors arrays kernel parser sequences words help
+help.topics namespaces vocabs definitions compiler.units ;
 IN: help.syntax
 
 : HELP:
@@ -16,7 +16,6 @@ IN: help.syntax
     over add-article >link r> remember-definition ; parsing
 
 : ABOUT:
-    scan-object
     in get vocab
     dup changed-definition
-    set-vocab-help ; parsing
+    scan-object >>help drop ; parsing

diff --git a/basis/help/topics/topics-tests.factor b/basis/help/topics/topics-tests.factor
index 745988c0776172a1c9ba1ac3c52151c9b959a68c..c52d5e347f49217d67fd980fd2adbfc561d84aa0 100644 (file)
--- a/basis/help/topics/topics-tests.factor
+++ b/basis/help/topics/topics-tests.factor
@@ -34,6 +34,6 @@ SYMBOL: foo
 ] unit-test
 
 [ { "testfile" 2 } ]
-[ { "test" 1 } articles get at article-loc ] unit-test
+[ { "test" 1 } articles get at loc>> ] unit-test
 
 [ ] [ { "test" 1 } remove-article ] unit-test

diff --git a/basis/help/topics/topics.factor b/basis/help/topics/topics.factor
index 14a6c3f8ad84b01ca8db085e8679ec8378e2fd03..cdb32b18eec94331d2fcd98d3a51459f17376c5c 100755 (executable)
--- a/basis/help/topics/topics.factor
+++ b/basis/help/topics/topics.factor
@@ -34,6 +34,8 @@ SYMBOL: article-xref
 article-xref global [ H{ } assoc-like ] change-at
 
 GENERIC: article-name ( topic -- string )
+GENERIC: article-title ( topic -- string )
+GENERIC: article-content ( topic -- content )
 GENERIC: article-parent ( topic -- parent )
 GENERIC: set-article-parent ( parent topic -- )
 
@@ -42,7 +44,9 @@ TUPLE: article title content loc ;
 : <article> ( title content -- article )
     f \ article boa ;
 
-M: article article-name article-title ;
+M: article article-name title>> ;
+M: article article-title title>> ;
+M: article article-content content>> ;
 
 ERROR: no-article name ;
 

diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor
index 006e0e7881712598ebb705269b91f7f7eaaf5832..909b2dcf3bfeb7d792edce4536f157fee131b3cb 100755 (executable)
--- a/basis/io/ports/ports.factor
+++ b/basis/io/ports/ports.factor
@@ -109,7 +109,7 @@ M: output-port stream-write1
 
 M: output-port stream-write
     dup check-disposed
-    over length over buffer>> buffer-size > [
+    over length over buffer>> size>> > [
         [ buffer>> size>> <groups> ]
         [ [ stream-write ] curry ] bi
         each

diff --git a/basis/models/models-docs.factor b/basis/models/models-docs.factor
index 8decf3251ce5dd42fe6f194928091f03ad975be5..97e4557adaa7bf1d967546c3e7609c38ecd1a226 100755 (executable)
--- a/basis/models/models-docs.factor
+++ b/basis/models/models-docs.factor
@@ -63,12 +63,7 @@ HELP: set-model
 { $values { "value" object } { "model" model } }
 { $description "Changes the value of a model and calls " { $link model-changed } " on all observers registered with " { $link add-connection } "." } ;
 
-{ set-model set-model-value change-model (change-model) } related-words
-
-HELP: set-model-value ( value model -- )
-{ $values { "value" object } { "model" model } }
-{ $description "Changes the value of a model without notifying any observers registered with " { $link add-connection } "." }
-{ $notes "There are very few reasons for user code to call this word. Instead, call " { $link set-model } ", which notifies observers." } ;
+{ set-model change-model (change-model) } related-words
 
 HELP: change-model
 { $values { "model" model } { "quot" "a quotation with stack effect " { $snippet "( obj -- newobj )" } } }

diff --git a/basis/peg/parsers/parsers.factor b/basis/peg/parsers/parsers.factor
index 6342deb79e1196ccdee638ea50438cd2bdb134c0..93de40d67201d60655c0643e5edf47b85dfdf39b 100755 (executable)
--- a/basis/peg/parsers/parsers.factor
+++ b/basis/peg/parsers/parsers.factor
@@ -17,7 +17,7 @@ TUPLE: just-parser p1 ;
 
 
 M: just-parser (compile) ( parser -- quot )
-  just-parser-p1 compile-parser just-pattern curry ;
+  p1>> compile-parser just-pattern curry ;
 
 : just ( parser -- parser )
   just-parser boa wrap-peg ;

diff --git a/basis/prettyprint/backend/backend.factor b/basis/prettyprint/backend/backend.factor
index 111bcfdafc7031c54cad805b2d1aa420b9f4b5c4..8e5e9326666b0fa7bb0b23a0b73f1e9ab112b1f3 100755 (executable)
--- a/basis/prettyprint/backend/backend.factor
+++ b/basis/prettyprint/backend/backend.factor
@@ -105,7 +105,7 @@ M: sbuf pprint*
     dup "SBUF\" " "\"" pprint-string ;
 
 M: pathname pprint*
-    dup pathname-string "P\" " "\"" pprint-string ;
+    dup string>> "P\" " "\"" pprint-string ;
 
 ! Sequences
 : nesting-limit? ( -- ? )

diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 49881f2e9febe738b3e4e3eefd7d504b2e6c0a98..63a44d85d4c2655d43d402a242ea9d2a6da83086 100755 (executable)
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -172,7 +172,7 @@ M: hook-generic synopsis*
         [ definer. ]
         [ seeing-word ]
         [ pprint-word ]
-        [ "combination" word-prop hook-combination-var pprint* ]
+        [ "combination" word-prop var>> pprint* ]
         [ stack-effect. ]
     } cleave ;
 

diff --git a/basis/prettyprint/sections/sections.factor b/basis/prettyprint/sections/sections.factor
index aed476b5c6542dda68842d7921f6acf42d86d99e..13c86ea99430e104d3699c3e6d03723d1879bbf3 100644 (file)
--- a/basis/prettyprint/sections/sections.factor
+++ b/basis/prettyprint/sections/sections.factor
@@ -205,7 +205,7 @@ TUPLE: text < section string ;
         swap >>style
         swap >>string ;
 
-M: text short-section text-string write ;
+M: text short-section string>> write ;
 
 M: text long-section short-section ;
 
@@ -291,17 +291,13 @@ SYMBOL: next
 
 : split-groups ( ? -- ) [ t , ] when ;
 
-M: f section-start-group? drop t ;
-
-M: f section-end-group? drop f ;
-
 : split-before ( section -- )
-    [ section-start-group? prev get section-end-group? and ]
+    [ start-group?>> prev get [ end-group?>> ] [ t ] if* and ]
     [ flow? prev get flow? not and ]
     bi or split-groups ;
 
 : split-after ( section -- )
-    section-end-group? split-groups ;
+    [ end-group?>> ] [ f ] if* split-groups ;
 
 : group-flow ( seq -- newseq )
     [

diff --git a/basis/tools/vocabs/browser/browser.factor b/basis/tools/vocabs/browser/browser.factor
index 55a96c8b7d06ce2d280ecf591ed95f505c97a8a6..a771a3573523fd01df79409d37e16f6d07ff4115 100755 (executable)
--- a/basis/tools/vocabs/browser/browser.factor
+++ b/basis/tools/vocabs/browser/browser.factor
@@ -181,12 +181,12 @@ M: vocab-spec article-parent drop "vocab-index" ;
 M: vocab-tag >link ;
 
 M: vocab-tag article-title
-    vocab-tag-name "Vocabularies tagged ``" swap "''" 3append ;
+    name>> "Vocabularies tagged ``" swap "''" 3append ;
 
-M: vocab-tag article-name vocab-tag-name ;
+M: vocab-tag article-name name>> ;
 
 M: vocab-tag article-content
-    \ $tagged-vocabs swap vocab-tag-name 2array ;
+    \ $tagged-vocabs swap name>> 2array ;
 
 M: vocab-tag article-parent drop "vocab-index" ;
 
@@ -195,12 +195,12 @@ M: vocab-tag summary article-title ;
 M: vocab-author >link ;
 
 M: vocab-author article-title
-    vocab-author-name "Vocabularies by " prepend ;
+    name>> "Vocabularies by " prepend ;
 
-M: vocab-author article-name vocab-author-name ;
+M: vocab-author article-name name>> ;
 
 M: vocab-author article-content
-    \ $authored-vocabs swap vocab-author-name 2array ;
+    \ $authored-vocabs swap name>> 2array ;
 
 M: vocab-author article-parent drop "vocab-index" ;
 

diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor
index 56567fab857ae29014477c7ed52e6bb5170527c8..7415bd0eb23075e808d6ed249a8be69976e09e03 100755 (executable)
--- a/core/assocs/assocs.factor
+++ b/core/assocs/assocs.factor
@@ -210,7 +210,7 @@ M: enum at*
 
 M: enum set-at seq>> set-nth ;
 
-M: enum delete-at enum-seq delete-nth ;
+M: enum delete-at seq>> delete-nth ;
 
 M: enum >alist ( enum -- alist )
     seq>> [ length ] keep zip ;

diff --git a/core/classes/mixin/mixin.factor b/core/classes/mixin/mixin.factor
index a7770e2eb287fc087b63cc2ba701411c786ff1a5..3a92d5193cf69b05680a2760161f42ecfd2b571a 100755 (executable)
--- a/core/classes/mixin/mixin.factor
+++ b/core/classes/mixin/mixin.factor
@@ -78,8 +78,8 @@ TUPLE: mixin-instance loc class mixin ;
 M: mixin-instance equal?
     {
         { [ over mixin-instance? not ] [ f ] }
-        { [ 2dup [ mixin-instance-class ] bi@ = not ] [ f ] }
-        { [ 2dup [ mixin-instance-mixin ] bi@ = not ] [ f ] }
+        { [ 2dup [ class>> ] bi@ = not ] [ f ] }
+        { [ 2dup [ mixin>> ] bi@ = not ] [ f ] }
         [ t ]
     } cond 2nip ;
 
@@ -91,15 +91,14 @@ M: mixin-instance hashcode*
         swap >>mixin
         swap >>class ;
 
-M: mixin-instance where mixin-instance-loc ;
+M: mixin-instance where loc>> ;
 
-M: mixin-instance set-where set-mixin-instance-loc ;
+M: mixin-instance set-where (>>loc) ;
 
 M: mixin-instance definer drop \ INSTANCE: f ;
 
 M: mixin-instance definition drop f ;
 
 M: mixin-instance forget*
-    dup mixin-instance-class
-    swap mixin-instance-mixin dup mixin-class?
-    [ remove-mixin-instance ] [ 2drop ] if ;
+    [ class>> ] [ mixin>> ] bi
+    mixin-class? [ remove-mixin-instance ] [ 2drop ] if ;

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 1d3c061a42a9f94bb7be9b2c17f9bd4b585a6a91..bfa3848186e2bab9a782e78a3590d223384b08d9 100755 (executable)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -178,7 +178,7 @@ M: condition compute-restarts
     [ error>> compute-restarts ]
     [
         [ restarts>> ]
-        [ condition-continuation [ <restart> ] curry ] bi
+        [ continuation>> [ <restart> ] curry ] bi
         { } assoc>map
     ] bi append ;
 

diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor
index 15ee233dbc55cf2ac3fc356e4c5bd717563a1536..36cec298bdf0b4e26b697198a3a577d30ce17d79 100755 (executable)
--- a/core/io/encodings/encodings.factor
+++ b/core/io/encodings/encodings.factor
@@ -130,9 +130,9 @@ M: encoder stream-write1
 M: encoder stream-write
     >encoder< decoder-write ;
 
-M: encoder dispose encoder-stream dispose ;
+M: encoder dispose stream>> dispose ;
 
-M: encoder stream-flush encoder-stream stream-flush ;
+M: encoder stream-flush stream>> stream-flush ;
 
 INSTANCE: encoder plain-writer
 PRIVATE>

diff --git a/core/source-files/source-files.factor b/core/source-files/source-files.factor
index aa2cd563a5d4528633e5d05687d78916211f7f48..767c2a1f79ec4c216392a72eb510c833a4fb73ae 100755 (executable)
--- a/core/source-files/source-files.factor
+++ b/core/source-files/source-files.factor
@@ -56,7 +56,7 @@ ERROR: invalid-source-file-path path ;
         ] [ 2drop ] if
     ] assoc-each ;
 
-M: pathname where pathname-string 1 2array ;
+M: pathname where string>> 1 2array ;
 
 : forget-source ( path -- )
     [
@@ -69,7 +69,7 @@ M: pathname where pathname-string 1 2array ;
     bi ;
 
 M: pathname forget*
-    pathname-string forget-source ;
+    string>> forget-source ;
 
 : rollback-source-file ( file -- )
     [

diff --git a/core/syntax/syntax.factor b/core/syntax/syntax.factor
index ce8494332852975cc42a568c8ba022dd35052beb..e1568329232bb246390403b080c25f880362f1fd 100755 (executable)
--- a/core/syntax/syntax.factor
+++ b/core/syntax/syntax.factor
@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien arrays byte-arrays byte-vectors
+USING: accessors alien arrays byte-arrays byte-vectors
 definitions generic hashtables kernel math namespaces parser
 lexer sequences strings strings.parser sbufs vectors
 words quotations io assocs splitting classes.tuple
@@ -193,7 +193,7 @@ IN: bootstrap.syntax
         "))" parse-effect parsed
     ] define-syntax
 
-    "MAIN:" [ scan-word in get vocab set-vocab-main ] define-syntax
+    "MAIN:" [ scan-word in get vocab (>>main) ] define-syntax
 
     "<<" [
         [

diff --git a/core/vocabs/vocabs.factor b/core/vocabs/vocabs.factor
index fedd6de3b7cfb6892c1ce7653469f497bf0197b7..1bdbe3ce1401b63dca1d61c2fa865942291c3ea4 100755 (executable)
--- a/core/vocabs/vocabs.factor
+++ b/core/vocabs/vocabs.factor
@@ -16,44 +16,78 @@ source-loaded? docs-loaded? ;
         swap >>name
         H{ } clone >>words ;
 
+GENERIC: vocab-name ( vocab-spec -- name )
+
 GENERIC: vocab ( vocab-spec -- vocab )
 
 M: vocab vocab ;
 
 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
 
+M: vocab vocab-name name>> ;
+
 M: string vocab-name ;
 
+GENERIC: vocab-words ( vocab-spec -- words )
+
+M: vocab vocab-words words>> ;
+
 M: object vocab-words vocab vocab-words ;
 
+M: f vocab-words ;
+
+GENERIC: vocab-help ( vocab-spec -- help )
+
+M: vocab vocab-help help>> ;
+
 M: object vocab-help vocab vocab-help ;
 
+M: f vocab-help ;
+
+GENERIC: vocab-main ( vocab-spec -- main )
+
+M: vocab vocab-main main>> ;
+
 M: object vocab-main vocab vocab-main ;
 
+M: f vocab-main ;
+
+GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
+
+M: vocab vocab-source-loaded? source-loaded?>> ;
+
 M: object vocab-source-loaded?
     vocab vocab-source-loaded? ;
 
+M: f vocab-source-loaded? ;
+
+GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
+
+M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
+
 M: object set-vocab-source-loaded?
     vocab set-vocab-source-loaded? ;
 
+M: f set-vocab-source-loaded? 2drop ;
+
+GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
+
+M: vocab vocab-docs-loaded? docs-loaded?>> ;
+
 M: object vocab-docs-loaded?
     vocab vocab-docs-loaded? ;
 
-M: object set-vocab-docs-loaded?
-    vocab set-vocab-docs-loaded? ;
-
-M: f vocab-words ;
+M: f vocab-docs-loaded? ;
 
-M: f vocab-source-loaded? ;
+GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
 
-M: f set-vocab-source-loaded? 2drop ;
+M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
 
-M: f vocab-docs-loaded? ;
+M: object set-vocab-docs-loaded?
+    vocab set-vocab-docs-loaded? ;
 
 M: f set-vocab-docs-loaded? 2drop ;
 
-M: f vocab-help ;
-
 : create-vocab ( name -- vocab )
     dictionary get [ <vocab> ] cache ;
 
@@ -90,10 +124,9 @@ TUPLE: vocab-link name ;
 : <vocab-link> ( name -- vocab-link )
     vocab-link boa ;
 
-M: vocab-link hashcode*
-    vocab-link-name hashcode* ;
+M: vocab-link hashcode* name>> hashcode* ;
 
-M: vocab-link vocab-name vocab-link-name ;
+M: vocab-link vocab-name name>> ;
 
 UNION: vocab-spec vocab vocab-link ;