Builtinn types now use new slot accessors; tuple slot type declaration work in progress

core/alien/alien-docs.factor

@@ -10,7 +10,7 @@ HELP: alien
 HELP: dll
 { $class-description "The class of native library handles. See " { $link "syntax-aliens" } " for syntax and " { $link "dll.private" } " for general information." } ;
 
-HELP: expired? ( c-ptr -- ? )
+HELP: expired?
 { $values { "c-ptr" "an alien, byte array, or " { $link f } } { "?" "a boolean" } }
 { $description "Tests if the alien is a relic from an earlier session. When an image is loaded, any alien objects which persisted in the image are marked as being expired."
 $nl

core/alien/alien.factor

@@ -1,13 +1,12 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: assocs kernel math namespaces sequences system
+USING: accessors assocs kernel math namespaces sequences system
 kernel.private bit-arrays byte-arrays float-arrays arrays ;
 IN: alien
 
 ! Some predicate classes used by the compiler for optimization
 ! purposes
-PREDICATE: simple-alien < alien
+PREDICATE: simple-alien < alien underlying>> not ;
-    underlying-alien not ;
 
 UNION: simple-c-ptr
 simple-alien POSTPONE: f byte-array bit-array float-array ;
@@ -17,12 +16,15 @@ alien POSTPONE: f byte-array bit-array float-array ;
 
 DEFER: pinned-c-ptr?
 
-PREDICATE: pinned-alien < alien
+PREDICATE: pinned-alien < alien underlying>> pinned-c-ptr? ;
-    underlying-alien pinned-c-ptr? ;
 
 UNION: pinned-c-ptr
     pinned-alien POSTPONE: f ;
 
+GENERIC: expired? ( c-ptr -- ? )
+
+M: alien expired? expired?>> ;
+
 M: f expired? drop t ;
 
 : <alien> ( address -- alien )

core/alien/c-types/c-types.factor

@@ -242,11 +242,10 @@ M: long-long-type box-return ( type -- )
     } 2cleave ;
 
 : expand-constants ( c-type -- c-type' )
-    #! We use word-def call instead of execute to get around
+    #! We use def>> call instead of execute to get around
     #! staging violations
     dup array? [
-        unclip >r [ dup word? [ word-def call ] when ] map
+        unclip >r [ dup word? [ def>> call ] when ] map r> prefix
-        r> prefix
     ] when ;
 
 : malloc-file-contents ( path -- alien len )

core/alien/remote-control/remote-control.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.c-types alien.strings parser threads words
+USING: accessors alien alien.c-types alien.strings parser
-kernel.private kernel io.encodings.utf8 ;
+threads words kernel.private kernel io.encodings.utf8 ;
 IN: alien.remote-control
 
 : eval-callback ( -- callback )
@@ -15,7 +15,7 @@ IN: alien.remote-control
     "void" { "long" } "cdecl" [ sleep ] alien-callback ;
 
 : ?callback ( word -- alien )
-    dup compiled? [ execute ] [ drop f ] if ; inline
+    dup compiled>> [ execute ] [ drop f ] if ; inline
 
 : init-remote-control ( -- )
     \ eval-callback ?callback 16 setenv

core/alien/strings/strings.factor

@@ -100,7 +100,7 @@ M: utf16n <encoder> drop utf16n <encoder> ;
     os windows? [ utf16n ] [ utf8 ] if alien>string ;
 
 : dll-path ( dll -- string )
-    (dll-path) alien>native-string ;
+    path>> alien>native-string ;
 
 : string>symbol ( str -- alien )
     [ os wince? [ utf16n ] [ utf8 ] if string>alien ]

core/alien/structs/structs-docs.factor

@@ -7,7 +7,7 @@ kernel words slots assocs namespaces ;
 : ($spec-reader-values) ( slot-spec class -- element )
     dup ?word-name swap 2array
     over slot-spec-name
-    rot slot-spec-type 2array 2array
+    rot slot-spec-class 2array 2array
     [ { $instance } swap suffix ] assoc-map ;
 
 : $spec-reader-values ( slot-spec class -- )
@@ -22,6 +22,9 @@ kernel words slots assocs namespaces ;
         " instance." ,
     ] { } make $description ;
 
+: slot-of-reader ( reader specs -- spec/f )
+    [ slot-spec-reader eq? ] with find nip ;
+
 : $spec-reader ( reader slot-specs class -- )
     >r slot-of-reader r>
     over [
@@ -49,6 +52,9 @@ M: word slot-specs "slots" word-prop ;
         " instance." ,
     ] { } make $description ;
 
+: slot-of-writer ( writer specs -- spec/f )
+    [ slot-spec-writer eq? ] with find nip ;
+
 : $spec-writer ( writer slot-specs class -- )
     >r slot-of-writer r>
     over [

core/alien/structs/structs.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables kernel kernel.private math
+USING: accessors arrays generic hashtables kernel kernel.private
-namespaces parser sequences strings words libc slots
+math namespaces parser sequences strings words libc slots
 slots.deprecated alien.c-types cpu.architecture ;
 IN: alien.structs
 
@@ -10,9 +10,9 @@ IN: alien.structs
 
 : struct-offsets ( specs -- size )
     0 [
-        [ slot-spec-type align-offset ] keep
+        [ class>> align-offset ] keep
         [ set-slot-spec-offset ] 2keep
-        slot-spec-type heap-size +
+        class>> heap-size +
     ] reduce ;
 
 : define-struct-slot-word ( spec word quot -- )
@@ -23,7 +23,7 @@ IN: alien.structs
     [ ]
     [ slot-spec-reader ]
     [
-        slot-spec-type
+        class>>
         [ c-getter ] [ c-type c-type-boxer-quot ] bi append
     ] tri
     define-struct-slot-word ;
@@ -32,7 +32,7 @@ IN: alien.structs
     [ set-writer-props ] keep
     [ ]
     [ slot-spec-writer ]
-    [ slot-spec-type c-setter ] tri
+    [ class>> c-setter ] tri
     define-struct-slot-word ;
 
 : define-field ( type spec -- )
@@ -77,13 +77,13 @@ M: struct-type stack-size
     -rot define-c-type ;
 
 : make-field ( struct-name vocab type field-name -- spec )
-    [
+    <slot-spec>
-        -rot expand-constants ,
+        0 >>offset
-        over ,
+        swap >>name
-        3dup reader-word ,
+        swap expand-constants >>class
-        writer-word ,
+        3dup name>> swap reader-word >>reader
-    ] { } make
+        3dup name>> swap writer-word >>writer
-    first4 0 -rot <slot-spec> ;
+    2nip ;
 
 : define-struct-early ( name vocab fields -- fields )
     -rot [ rot first2 make-field ] 2curry map ;
@@ -94,7 +94,7 @@ M: struct-type stack-size
 : define-struct ( name vocab fields -- )
     pick >r
     [ struct-offsets ] keep
-    [ [ slot-spec-type ] map compute-struct-align ] keep
+    [ [ class>> ] map compute-struct-align ] keep
     [ (define-struct) ] keep
     r> [ swap define-field ] curry each ;
 

core/bootstrap/compiler/compiler.factor

@@ -1,11 +1,12 @@
 ! Copyright (C) 2007, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: compiler cpu.architecture vocabs.loader system sequences
+USING: accessors compiler cpu.architecture vocabs.loader system
-namespaces parser kernel kernel.private classes classes.private
+sequences namespaces parser kernel kernel.private classes
-arrays hashtables vectors classes.tuple sbufs inference.dataflow
+classes.private arrays hashtables vectors classes.tuple sbufs
-hashtables.private sequences.private math classes.tuple.private
+inference.dataflow hashtables.private sequences.private math
-growable namespaces.private assocs words generator command-line
+classes.tuple.private growable namespaces.private assocs words
-vocabs io prettyprint libc compiler.units math.order ;
+generator command-line vocabs io prettyprint libc compiler.units
+math.order ;
 IN: bootstrap.compiler
 
 ! Don't bring this in when deploying, since it will store a
@@ -14,12 +15,12 @@ IN: bootstrap.compiler
     "alien.remote-control" require
 ] unless
 
-"cpu." cpu word-name append require
+"cpu." cpu name>> append require
 
 enable-compiler
 
 : compile-uncompiled ( words -- )
-    [ compiled? not ] filter compile ;
+    [ compiled>> not ] filter compile ;
 
 nl
 "Compiling..." write flush
@@ -40,8 +41,6 @@ nl
 
     wrap probe
 
-    underlying
-
     namestack*
 
     bitand bitor bitxor bitnot

core/bootstrap/image/image.factor

@@ -12,8 +12,8 @@ io.encodings.binary math.order accessors ;
 IN: bootstrap.image
 
 : my-arch ( -- arch )
-    cpu word-name
+    cpu name>> 
-    dup "ppc" = [ >r os word-name "-" r> 3append ] when ;
+    dup "ppc" = [ >r os name>> "-" r> 3append ] when ;
 
 : boot-image-name ( arch -- string )
     "boot." swap ".image" 3append ;
@@ -260,10 +260,10 @@ M: f '
             [
                 {
                     [ hashcode , ]
-                    [ word-name , ]
+                    [ name>> , ]
-                    [ word-vocabulary , ]
+                    [ vocabulary>> , ]
-                    [ word-def , ]
+                    [ def>> , ]
-                    [ word-props , ]
+                    [ props>> , ]
                 } cleave
                 f ,
                 0 , ! count
@@ -277,7 +277,7 @@ M: f '
     ] keep put-object ;
 
 : word-error ( word msg -- * )
-    [ % dup word-vocabulary % " " % word-name % ] "" make throw ;
+    [ % dup vocabulary>> % " " % name>> % ] "" make throw ;
 
 : transfer-word ( word -- word )
     [ target-word ] keep or ;
@@ -294,7 +294,7 @@ M: word ' ;
 ! Wrappers
 
 M: wrapper '
-    wrapped ' wrapper type-number object tag-number
+    wrapped>> ' wrapper type-number object tag-number
     [ emit ] emit-object ;
 
 ! Strings
@@ -345,7 +345,7 @@ M: float-array ' float-array emit-dummy-array ;
     tuple type-number dup [ emit-seq ] emit-object ;
 
 : emit-tuple ( tuple -- pointer )
-    dup class word-name "tombstone" =
+    dup class name>> "tombstone" =
     [ [ (emit-tuple) ] cache-object ] [ (emit-tuple) ] if ;
 
 M: tuple ' emit-tuple ;
@@ -354,11 +354,11 @@ M: tuple-layout '
     [
         [
             {
-                [ layout-hashcode , ]
+                [ hashcode>> , ]
-                [ layout-class , ]
+                [ class>> , ]
-                [ layout-size , ]
+                [ size>> , ]
-                [ layout-superclasses , ]
+                [ superclasses>> , ]
-                [ layout-echelon , ]
+                [ echelon>> , ]
             } cleave
         ] { } make [ ' ] map
         \ tuple-layout type-number
@@ -368,7 +368,7 @@ M: tuple-layout '
 M: tombstone '
     delegate
     "((tombstone))" "((empty))" ? "hashtables.private" lookup
-    word-def first [ emit-tuple ] cache-object ;
+    def>> first [ emit-tuple ] cache-object ;
 
 ! Arrays
 M: array '
@@ -379,10 +379,10 @@ M: array '
 
 M: quotation '
     [
-        quotation-array '
+        array>> '
         quotation type-number object tag-number [
             emit ! array
-            f ' emit ! compiled?
+            f ' emit ! compiled>>
             0 emit ! xt
             0 emit ! code
         ] emit-object

core/bootstrap/primitives.factor

@@ -5,7 +5,7 @@ hashtables.private io kernel math namespaces parser sequences
 strings vectors words quotations assocs layouts classes
 classes.builtin classes.tuple classes.tuple.private
 kernel.private vocabs vocabs.loader source-files definitions
-slots.deprecated classes.union classes.intersection
+slots classes.union classes.intersection
 compiler.units bootstrap.image.private io.files accessors
 combinators ;
 IN: bootstrap.primitives
@@ -133,9 +133,12 @@ bootstrapping? on
     [ f f f builtin-class define-class ]
     tri ;
 
-: define-builtin-slots ( symbol slotspec -- )
+: prepare-slots ( slots -- slots' )
-    [ drop ] [ 1 simple-slots ] 2bi
+    [ [ dup array? [ first2 create ] when ] map ] map ;
-    [ "slots" set-word-prop ] [ define-slots ] 2bi ;
+
+: define-builtin-slots ( class slots -- )
+    prepare-slots 1 make-slots
+    [ "slots" set-word-prop ] [ define-accessors ] 2bi ;
 
 : define-builtin ( symbol slotspec -- )
     >r [ define-builtin-predicate ] keep
@@ -189,16 +192,14 @@ bi
 
 "ratio" "math" create {
     {
-        { "integer" "math" }
         "numerator"
-        { "numerator" "math" }
+        { "integer" "math" }
-        f
+        read-only: t
     }
     {
-        { "integer" "math" }
         "denominator"
-        { "denominator" "math" }
+        { "integer" "math" }
-        f
+        read-only: t
     }
 } define-builtin
 
@@ -207,16 +208,14 @@ bi
 
 "complex" "math" create {
     {
+        "real"
         { "real" "math" }
-        "real-part"
+        read-only: t
-        { "real-part" "math" }
-        f
     }
     {
+        "imaginary"
         { "real" "math" }
-        "imaginary-part"
+        read-only: t
-        { "imaginary-part" "math" }
-        f
     }
 } define-builtin
 
@@ -226,104 +225,87 @@ bi
 
 "wrapper" "kernel" create {
     {
-        { "object" "kernel" }
         "wrapped"
-        { "wrapped" "kernel" }
+        { "object" "kernel" }
-        f
+        read-only: t
     }
 } define-builtin
 
 "string" "strings" create {
     {
-        { "array-capacity" "sequences.private" }
         "length"
-        { "length" "sequences" }
+        { "array-capacity" "sequences.private" }
-        f
+        read-only: t
     } {
-        { "object" "kernel" }
         "aux"
-        { "string-aux" "strings.private" }
+        { "object" "kernel" }
-        { "set-string-aux" "strings.private" }
     }
 } define-builtin
 
 "quotation" "quotations" create {
     {
-        { "object" "kernel" }
         "array"
-        { "quotation-array" "quotations.private" }
+        { "object" "kernel" }
-        f
+        read-only: t
     }
     {
+        "compiled"
         { "object" "kernel" }
-        "compiled?"
+        read-only: t
-        { "quotation-compiled?" "quotations" }
-        f
     }
 } define-builtin
 
 "dll" "alien" create {
     {
-        { "byte-array" "byte-arrays" }
+       "path"
-        "path"
+         { "byte-array" "byte-arrays" }
-        { "(dll-path)" "alien" }
+        read-only: t
-        f
     }
 }
 define-builtin
 
 "alien" "alien" create {
     {
+        "underlying"
         { "c-ptr" "alien" }
-        "alien"
+        read-only: t
-        { "underlying-alien" "alien" }
-        f
     } {
-        { "object" "kernel" }
         "expired?"
-        { "expired?" "alien" }
+        { "object" "kernel" }
-        f
+        read-only: t
     }
 }
 define-builtin
 
 "word" "words" create {
-    f
-    {
-        { "object" "kernel" }
-        "name"
-        { "word-name" "words" }
-        { "set-word-name" "words" }
-    }
-    {
-        { "object" "kernel" }
-        "vocabulary"
-        { "word-vocabulary" "words" }
-        { "set-word-vocabulary" "words" }
-    }
-    {
-        { "quotation" "quotations" }
-        "def"
-        { "word-def" "words" }
-        { "set-word-def" "words.private" }
-    }
-    {
-        { "object" "kernel" }
-        "props"
-        { "word-props" "words" }
-        { "set-word-props" "words" }
-    }
-    {
-        { "object" "kernel" }
-        "compiled?"
-        { "compiled?" "words" }
-        f
-    }
     {
+        "hashcode"
         { "fixnum" "math" }
+    }
+    {
+        "name"
+        { "object" "kernel" }
+    }
+    {
+        "vocabulary"
+        { "object" "kernel" }
+    }
+    {
+        "def"
+        { "quotation" "quotations" }
+    }
+    {
+        "props"
+        { "object" "kernel" }
+    }
+    {
+        "compiled"
+        { "object" "kernel" }
+        read-only: t
+    }
+    {
         "counter"
-        { "profile-counter" "tools.profiler.private" }
+        { "fixnum" "math" }
-        { "set-profile-counter" "tools.profiler.private" }
     }
 } define-builtin
 
@@ -337,34 +319,29 @@ define-builtin
 
 "tuple-layout" "classes.tuple.private" create {
     {
-        { "fixnum" "math" }
         "hashcode"
-        { "layout-hashcode" "classes.tuple.private" }
+        { "fixnum" "math" }
-        f
+        read-only: t
     }
     {
-        { "word" "words" }
         "class"
-        { "layout-class" "classes.tuple.private" }
+        { "word" "words" }
-        f
+        read-only: t
     }
     {
-        { "fixnum" "math" }
         "size"
-        { "layout-size" "classes.tuple.private" }
-        f
-    }
-    {
-        { "array" "arrays" }
-        "superclasses"
-        { "layout-superclasses" "classes.tuple.private" }
-        f
-    }
-    {
         { "fixnum" "math" }
+        read-only: t
+    }
+    {
+        "superclasses"
+        { "array" "arrays" }
+        read-only: t
+    }
+    {
         "echelon"
-        { "layout-echelon" "classes.tuple.private" }
+        { "fixnum" "math" }
-        f
+        read-only: t
     }
 } define-builtin
 
@@ -375,15 +352,13 @@ define-builtin
     [
         {
             {
-                { "object" "kernel" }
                 "delegate"
-                { "delegate" "kernel" }
+                { "object" "kernel" }
-                { "set-delegate" "kernel" }
             }
-        }
+        } prepare-slots
         [ drop ] [ generate-tuple-slots ] 2bi
         [ "slots" set-word-prop ]
-        [ define-slots ]
+        [ define-accessors ]
         2bi
     ]
 } cleave
@@ -405,90 +380,19 @@ tuple
 2array >tuple 1quotation define-inline
 
 ! Some tuple classes
-"hashtable" "hashtables" create
-tuple
-{
-    {
-        { "array-capacity" "sequences.private" }
-        "count"
-        { "hash-count" "hashtables.private" }
-        { "set-hash-count" "hashtables.private" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "deleted"
-        { "hash-deleted" "hashtables.private" }
-        { "set-hash-deleted" "hashtables.private" }
-    } {
-        { "array" "arrays" }
-        "array"
-        { "hash-array" "hashtables.private" }
-        { "set-hash-array" "hashtables.private" }
-    }
-} define-tuple-class
-
-"sbuf" "sbufs" create
-tuple
-{
-    {
-        { "string" "strings" }
-        "underlying"
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "length"
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    }
-} define-tuple-class
-
-"vector" "vectors" create
-tuple
-{
-    {
-        { "array" "arrays" }
-        "underlying"
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "fill"
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    }
-} define-tuple-class
-
-"byte-vector" "byte-vectors" create
-tuple
-{
-    {
-        { "byte-array" "byte-arrays" }
-        "underlying"
-        { "underlying" "growable" }
-        { "set-underlying" "growable" }
-    } {
-        { "array-capacity" "sequences.private" }
-        "fill"
-        { "length" "sequences" }
-        { "set-fill" "growable" }
-    }
-} define-tuple-class
-
 "curry" "kernel" create
 tuple
 {
     {
-        { "object" "kernel" }
         "obj"
-        { "curry-obj" "kernel" }
-        f
-    } {
         { "object" "kernel" }
+        read-only: t
+    } {
         "quot"
-        { "curry-quot" "kernel" }
+        { "object" "kernel" }
-        f
+        read-only: t
     }
-} define-tuple-class
+} prepare-slots define-tuple-class
 
 "curry" "kernel" lookup
 [ f "inline" set-word-prop ]
@@ -500,17 +404,15 @@ tuple
 tuple
 {
     {
-        { "object" "kernel" }
         "first"
-        { "compose-first" "kernel" }
-        f
-    } {
         { "object" "kernel" }
+        read-only: t
+    } {
         "second"
-        { "compose-second" "kernel" }
+        { "object" "kernel" }
-        f
+        read-only: t
     }
-} define-tuple-class
+} prepare-slots define-tuple-class
 
 "compose" "kernel" lookup
 [ f "inline" set-word-prop ]

core/bootstrap/stage2.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: init command-line namespaces words debugger io
+USING: accessors init command-line namespaces words debugger io
 kernel.private math memory continuations kernel io.files
 io.backend system parser vocabs sequences prettyprint
 vocabs.loader combinators splitting source-files strings
@@ -36,7 +36,7 @@ SYMBOL: bootstrap-time
     "Bootstrap completed in " write number>string write
     " minutes and " write number>string write " seconds." print
 
-    [ compiled? ] count-words " compiled words" print
+    [ compiled>> ] count-words " compiled words" print
     [ symbol? ] count-words " symbol words" print
     [ ] count-words " words total" print
 

core/bootstrap/syntax.factor

@@ -45,6 +45,7 @@ IN: bootstrap.syntax
     "SINGLETON:"
     "SYMBOL:"
     "TUPLE:"
+    "SLOT:"
     "T{"
     "UNION:"
     "INTERSECTION:"
@@ -68,6 +69,8 @@ IN: bootstrap.syntax
     "<<"
     ">>"
     "call-next-method"
+    "initial:"
+    "read-only:"
 } [ "syntax" create drop ] each
 
 "t" "syntax" lookup define-symbol

core/byte-vectors/byte-vectors.factor

@@ -4,6 +4,10 @@ USING: arrays kernel kernel.private math sequences
 sequences.private growable byte-arrays ;
 IN: byte-vectors
 
+TUPLE: byte-vector
+{ "underlying" byte-array }
+{ "length" array-capacity } ;
+
 <PRIVATE
 
 : byte-array>vector ( byte-array length -- byte-vector )

core/classes/algebra/algebra.factor

@@ -214,7 +214,7 @@ PREDICATE: empty-intersection < anonymous-intersection participants>> empty? ;
     [ "Topological sort failed" throw ] unless* ;
 
 : sort-classes ( seq -- newseq )
-    [ [ word-name ] compare ] sort >vector
+    [ [ name>> ] compare ] sort >vector
     [ dup empty? not ]
     [ dup largest-class >r over delete-nth r> ]
     [ ] unfold nip ;

core/classes/classes.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions assocs kernel kernel.private
+USING: accessors arrays definitions assocs kernel kernel.private
 slots.private namespaces sequences strings words vectors math
 quotations combinators sorting effects graphs vocabs sets ;
 IN: classes
@@ -38,7 +38,7 @@ PREDICATE: tuple-class < class
 : classes ( -- seq ) implementors-map get keys ;
 
 : predicate-word ( word -- predicate )
-    [ word-name "?" append ] keep word-vocabulary create ;
+    [ name>> "?" append ] [ vocabulary>> ] bi create ;
 
 PREDICATE: predicate < word "predicating" word-prop >boolean ;
 
@@ -123,8 +123,8 @@ M: sequence implementors [ implementors ] gather ;
     dup class? [ dup [ implementors-map+ ] [ new-class ] bi ] unless
     dup reset-class
     dup deferred? [ dup define-symbol ] when
-    dup word-props
+    dup props>>
-    r> assoc-union over set-word-props
+    r> assoc-union >>props
     dup predicate-word
     [ 1quotation "predicate" set-word-prop ]
     [ swap "predicating" set-word-prop ]

core/classes/tuple/parser/parser-tests.factor

@@ -0,0 +1,59 @@
+IN: classes.tuple.parser.tests
+USING: accessors classes.tuple.parser lexer words classes
+sequences math kernel slots tools.test parser compiler.units ;
+
+TUPLE: test-1 ;
+
+[ t ] [ test-1 "slot-names" word-prop empty? ] unit-test
+
+TUPLE: test-2 < test-1 ;
+
+[ t ] [ test-2 "slot-names" word-prop empty? ] unit-test
+[ test-1 ] [ test-2 superclass ] unit-test
+
+TUPLE: test-3 a ;
+
+[ { "a" } ] [ test-3 "slot-names" word-prop ] unit-test
+
+[ object ] [ "a" test-3 "slots" word-prop slot-named class>> ] unit-test
+
+TUPLE: test-4 < test-3 b ;
+
+[ { "b" } ] [ test-4 "slot-names" word-prop ] unit-test
+
+TUPLE: test-5 { "a" integer } ;
+
+[ { { "a" integer } } ] [ test-5 "slot-names" word-prop ] unit-test
+
+TUPLE: test-6 < test-5 { "b" integer } ;
+
+[ integer ] [ "b" test-6 "slots" word-prop slot-named class>> ] unit-test
+
+[ { { "b" integer } } ] [ test-6 "slot-names" word-prop ] unit-test
+
+TUPLE: test-7 { "b" integer initial: 3 } ;
+
+[ 3 ] [ "b" test-7 "slots" word-prop slot-named initial>> ] unit-test
+
+TUPLE: test-8 { "b" integer read-only: t } ;
+
+[ t ] [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
+
+[ "IN: classes.tuple.parser.tests TUPLE: foo < test-1 < ;" eval ]
+[ error>> invalid-slot-name? ]
+must-fail-with
+
+[ "IN: classes.tuple.parser.tests TUPLE: foo :" eval ]
+[ error>> invalid-slot-name? ]
+must-fail-with
+
+[ "IN: classes.tuple.parser.tests TUPLE: foo" eval ]
+[ error>> unexpected-eof? ]
+must-fail-with
+
+[ ] [
+    [
+        { test-1 test-2 test-3 test-4 test-5 test-6 test-7 test-8 }
+        [ dup class? [ forget-class ] [ drop ] if ] each
+    ] with-compilation-unit
+] unit-test

core/classes/tuple/parser/parser.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel sets namespaces sequences inspector parser
+USING: accessors kernel sets namespaces sequences inspector parser
-lexer combinators words classes.parser classes.tuple ;
+lexer combinators words classes.parser classes.tuple arrays ;
 IN: classes.tuple.parser
 
 : shadowed-slots ( superclass slots -- shadowed )
@@ -13,7 +13,7 @@ IN: classes.tuple.parser
             "Definition of slot ``" %
             %
             "'' in class ``" %
-            word-name %
+            name>> %
             "'' shadows a superclass slot" %
         ] "" make note.
     ] with each ;
@@ -24,27 +24,27 @@ M: invalid-slot-name summary
     drop
     "Invalid slot name" ;
 
-: (parse-tuple-slots) ( -- )
+: parse-slot-name ( string/f -- ? )
     #! This isn't meant to enforce any kind of policy, just
     #! to check for mistakes of this form:
     #!
     #! TUPLE: blahblah foo bing
     #!
     #! : ...
-    scan {
+    {
         { [ dup not ] [ unexpected-eof ] }
-        { [ dup { ":" "(" "<" } member? ] [ invalid-slot-name ] }
+        { [ dup { ":" "(" "<" "\"" } member? ] [ invalid-slot-name ] }
-        { [ dup ";" = ] [ drop ] }
+        { [ dup ";" = ] [ drop f ] }
-        [ , (parse-tuple-slots) ]
+        [ dup "{" = [ drop \ } parse-until >array ] when , t ]
     } cond ;
 
-: parse-tuple-slots ( -- seq )
+: parse-tuple-slots ( -- )
-    [ (parse-tuple-slots) ] { } make ;
+    scan parse-slot-name [ parse-tuple-slots ] when ;
 
 : parse-tuple-definition ( -- class superclass slots )
     CREATE-CLASS
     scan {
         { ";" [ tuple f ] }
-        { "<" [ scan-word parse-tuple-slots ] }
+        { "<" [ scan-word [ parse-tuple-slots ] { } make ] }
-        [ >r tuple parse-tuple-slots r> prefix ]
+        [ tuple swap [ parse-slot-name [ parse-tuple-slots ] when ] { } make ]
     } case 3dup check-slot-shadowing ;

core/classes/tuple/tuple-docs.factor

@@ -1,6 +1,7 @@
 USING: generic help.markup help.syntax kernel
 classes.tuple.private classes slots quotations words arrays
-generic.standard sequences definitions compiler.units ;
+generic.standard sequences definitions compiler.units
+growable vectors sbufs ;
 IN: classes.tuple
 
 ARTICLE: "parametrized-constructors" "Parameterized constructors"
@@ -242,6 +243,34 @@ $nl
 }
 "Note that if a slot is moved from a class to its superclass (or vice versa) in the same compilation unit, the value of the slot is preserved in existing instances, because tuple instance update always runs at the end of a compilation unit. However, if it is removed in one compilation unit and added in another, the value in existing instances is lost." ;
 
+ARTICLE: "protocol-slots" "Protocol slots"
+"A " { $emphasis "protocol slot" } " is one which is assumed to exist by the implementation of a class, without being defined on the class itself. The burden is on subclasses (or mixin instances) to provide this slot."
+$nl
+"Protocol slots are defined using a parsing word:"
+{ $subsection POSTPONE: SLOT: }
+"Protocol slots are used where the implementation of a superclass needs to assume that each subclass defines certain slots, however the slots of each subclass are potentially declared with different class specializers, thus preventing the slots from being defined in the superclass."
+$nl
+"For example, the " { $link growable } " mixin provides an implementation of the sequence protocol which wraps an underlying sequence, resizing it as necessary when elements are added beyond the length of the sequence. It assumes that the concrete mixin instances define two slots, " { $snippet "length" } " and " { $snippet "underlying" } ". These slots are defined as protocol slots:"
+{ $snippet "SLOT: length" "SLOT: underlying" }
+"An alternate approach would be to define " { $link growable } " as a tuple class with these two slots, and have other classes subclass it as required. However, this rules out subclasses defining these slots with custom type declarations."
+$nl
+"For example, compare the definitions of the " { $link sbuf } " class,"
+{ $code
+    "TUPLE: sbuf"
+    "{ \"underlying\" string }"
+    "{ \"length\" array-capacity } ;"
+    ""
+    "INSTANCE: sbuf growable"
+}
+"with that of the " { $link vector } " class:"
+{ $code
+    "TUPLE: vector"
+    "{ \"underlying\" array }"
+    "{ \"length\" array-capacity } ;"
+    ""
+    "INSTANCE: vector growable"
+} ;
+
 ARTICLE: "tuples" "Tuples"
 "Tuples are user-defined classes composed of named slots."
 { $subsection "tuple-examples" }
@@ -255,6 +284,8 @@ $nl
 { $subsection "tuple-constructors" }
 "Expressing relationships through the object system:"
 { $subsection "tuple-subclassing" }
+"Protocol slots:"
+{ $subsection "protocol-slots" }
 "Introspection:"
 { $subsection "tuple-introspection" }
 "Tuple classes can be redefined; this updates existing instances:"

core/classes/tuple/tuple-tests.factor

@@ -88,13 +88,13 @@ C: <empty> empty
 [ t length ] [ object>> t eq? ] must-fail-with
 
 [ "<constructor-test>" ]
-[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word word-name ] unit-test
+[ "IN: classes.tuple.test TUPLE: constructor-test ; C: <constructor-test> constructor-test" eval word name>> ] unit-test
 
 TUPLE: size-test a b c d ;
 
 [ t ] [
     T{ size-test } tuple-size
-    size-test tuple-layout layout-size =
+    size-test tuple-layout size>> =
 ] unit-test
 
 GENERIC: <yo-momma>
@@ -253,8 +253,8 @@ test-laptop-slot-values
 
 [ laptop ] [
     "laptop" get 1 slot
-    dup layout-echelon swap
+    dup echelon>> swap
-    layout-superclasses nth
+    superclasses>> nth
 ] unit-test
 
 [ "TUPLE: laptop < computer battery ;" ] [

core/classes/tuple/tuple.factor

@@ -25,7 +25,7 @@ ERROR: not-a-tuple-class class ;
     check-tuple-class "layout" word-prop ;
 
 : tuple-size ( tuple -- size )
-    1 slot layout-size ; inline
+    1 slot size>> ; inline
 
 : prepare-tuple>array ( tuple -- n tuple layout )
     check-tuple [ tuple-size ] [ ] [ 1 slot ] tri ;
@@ -38,7 +38,7 @@ PRIVATE>
 : tuple>array ( tuple -- array )
     prepare-tuple>array
     >r copy-tuple-slots r>
-    layout-class prefix ;
+    class>> prefix ;
 
 : tuple-slots ( tuple -- seq )
     prepare-tuple>array drop copy-tuple-slots ;
@@ -78,10 +78,10 @@ ERROR: bad-superclass class ;
     #! 5 slot == layout-echelon
     [
         [ 1 slot dup 5 slot ] %
-        dup tuple-layout layout-echelon ,
+        dup tuple-layout echelon>> ,
         [ fixnum>= ] %
         [
-            dup tuple-layout layout-echelon ,
+            dup tuple-layout echelon>> ,
             [ swap 4 slot array-nth ] %
             literalize ,
             [ eq? ] %
@@ -106,7 +106,7 @@ ERROR: bad-superclass class ;
     [ slot-names length ] map sum ;
 
 : generate-tuple-slots ( class slots -- slot-specs )
-    over superclass-size 2 + simple-slots ;
+    over superclass-size 2 + make-slots deprecated-slots ;
 
 : define-tuple-slots ( class -- )
     dup dup "slot-names" word-prop generate-tuple-slots
@@ -212,13 +212,14 @@ M: tuple-class define-tuple-class
 
 M: tuple-class reset-class
     [
-        dup "slot-names" word-prop [
+        dup "slots" word-prop [
+            name>>
             [ reader-word method forget ]
             [ writer-word method forget ] 2bi
         ] with each
     ] [
         [ call-next-method ]
-        [ { "layout" "slots" } reset-props ]
+        [ { "layout" "slots" "slot-names" } reset-props ]
         bi
     ] bi ;
 

core/combinators/combinators-tests.factor

@@ -140,7 +140,7 @@ IN: combinators.tests
 [ "two" ] [ 2 case-test-1 ] unit-test
 
 ! Interpreted
-[ "two" ] [ 2 \ case-test-1 word-def call ] unit-test
+[ "two" ] [ 2 \ case-test-1 def>> call ] unit-test
 
 [ "x" case-test-1 ] must-fail
 
@@ -158,7 +158,7 @@ IN: combinators.tests
 [ 25 ] [ 5 case-test-2 ] unit-test
 
 ! Interpreted
-[ 25 ] [ 5 \ case-test-2 word-def call ] unit-test
+[ 25 ] [ 5 \ case-test-2 def>> call ] unit-test
 
 : case-test-3 ( obj -- obj' )
     {
@@ -288,7 +288,7 @@ IN: combinators.tests
 ] unit-test
 
 ! Interpreted
-[ "a hashtable" ] [ H{ } \ case-test-3 word-def call ] unit-test
+[ "a hashtable" ] [ H{ } \ case-test-3 def>> call ] unit-test
 
 [ 1 3 t ] [ { 1 3 2 } contiguous-range? ] unit-test
 [ f ] [ { 1 2 2 4 } contiguous-range? 2nip ] unit-test

core/combinators/combinators.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays sequences sequences.private math.private
+USING: accessors arrays sequences sequences.private math.private
 kernel kernel.private math assocs quotations vectors
 hashtables sorting words sets math.order ;
 IN: combinators
@@ -45,7 +45,7 @@ ERROR: no-case ;
             dupd first dup word? [
                 execute
             ] [
-                dup wrapper? [ wrapped ] when
+                dup wrapper? [ wrapped>> ] when
             ] if =
         ] [ quotation? ] if
     ] find nip ;

core/compiler/tests/intrinsics.factor

@@ -377,7 +377,7 @@ cell 8 = [
 [ 252 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-unsigned-1 ] compile-call ] unit-test
 [ -4 ] [ B{ 1 2 3 -4 5 } 3 [ { byte-array fixnum } declare alien-signed-1 ] compile-call ] unit-test
 
-: xword-def ( word -- def ) word-def [ { fixnum } declare ] prepend ;
+: xword-def ( word -- def ) def>> [ { fixnum } declare ] prepend ;
 
 [ -100 ] [ -100 <char> [ { byte-array } declare *char ] compile-call ] unit-test
 [ 156 ] [ -100 <uchar> [ { byte-array } declare *uchar ] compile-call ] unit-test

core/compiler/tests/redefine1.factor

@@ -23,13 +23,13 @@ M: integer method-redefine-test 3 + ;
 : hey ( -- ) ;
 : there ( -- ) hey ;
 
-[ t ] [ \ hey compiled? ] unit-test
+[ t ] [ \ hey compiled>> ] unit-test
-[ t ] [ \ there compiled? ] unit-test
+[ t ] [ \ there compiled>> ] unit-test
 [ ] [ "IN: compiler.tests : hey ( -- ) 3 ;" eval ] unit-test
-[ f ] [ \ hey compiled? ] unit-test
+[ f ] [ \ hey compiled>> ] unit-test
-[ f ] [ \ there compiled? ] unit-test
+[ f ] [ \ there compiled>> ] unit-test
 [ ] [ "IN: compiler.tests : hey ( -- ) ;" eval ] unit-test
-[ t ] [ \ there compiled? ] unit-test
+[ t ] [ \ there compiled>> ] unit-test
 
 ! Just changing the stack effect didn't mark a word for recompilation
 DEFER: change-effect
@@ -44,24 +44,24 @@ DEFER: change-effect
 : bad ( -- ) good ;
 : ugly ( -- ) bad ;
 
-[ t ] [ \ good compiled? ] unit-test
+[ t ] [ \ good compiled>> ] unit-test
-[ t ] [ \ bad compiled? ] unit-test
+[ t ] [ \ bad compiled>> ] unit-test
-[ t ] [ \ ugly 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 ] [ \ good compiled>> ] unit-test
-[ f ] [ \ bad compiled? ] unit-test
+[ f ] [ \ bad compiled>> ] unit-test
-[ f ] [ \ ugly 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 ] [ \ good compiled>> ] unit-test
-[ t ] [ \ bad compiled? ] unit-test
+[ t ] [ \ bad compiled>> ] unit-test
-[ t ] [ \ ugly compiled? ] unit-test
+[ t ] [ \ ugly compiled>> ] unit-test
 
 [ f ] [ \ good compiled-usage assoc-empty? ] unit-test

core/compiler/tests/redefine3.factor

@@ -14,7 +14,7 @@ M: empty-mixin sheeple drop "wake up" ;
 : sheeple-test ( -- string ) { } sheeple ;
 
 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test compiled? ] 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
 
@@ -27,6 +27,6 @@ M: empty-mixin sheeple drop "wake up" ;
 [ ] [ [ array empty-mixin remove-mixin-instance ] with-compilation-unit ] unit-test
 
 [ "sheeple" ] [ sheeple-test ] unit-test
-[ t ] [ \ sheeple-test compiled? ] 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

core/compiler/tests/simple.factor

@@ -235,6 +235,6 @@ M: f single-combination-test-2 single-combination-test-4 ;
 10 [
     [ "compiler.tests.foo" forget-vocab ] with-compilation-unit
     [ t ] [
-        "USING: prettyprint words ; IN: compiler.tests.foo : (recursive) (  -- ) (recursive) (recursive) ; inline : recursive ( -- ) (recursive) ; \\ (recursive) compiled?" eval
+        "USING: prettyprint words ; IN: compiler.tests.foo : (recursive) (  -- ) (recursive) (recursive) ; inline : recursive ( -- ) (recursive) ; \\ (recursive) compiled>>" eval
     ] unit-test
 ] times

core/compiler/tests/templates.factor

@@ -245,13 +245,13 @@ TUPLE: my-tuple ;
         [ dup float+ ]
     } cleave ;
 
-[ t ] [ \ float-spill-bug compiled? ] unit-test
+[ t ] [ \ float-spill-bug compiled>> ] unit-test
 
 ! Regression
 : dispatch-alignment-regression ( -- c )
     { tuple vector } 3 slot { word } declare
     dup 1 slot 0 fixnum-bitand { [ ] } dispatch ;
 
-[ t ] [ \ dispatch-alignment-regression compiled? ] unit-test
+[ t ] [ \ dispatch-alignment-regression compiled>> ] unit-test
 
 [ vector ] [ dispatch-alignment-regression ] unit-test

core/compiler/units/units.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel continuations assocs namespaces sequences words
+USING: accessors kernel continuations assocs namespaces
-vocabs definitions hashtables init sets ;
+sequences words vocabs definitions hashtables init sets ;
 IN: compiler.units
 
 SYMBOL: old-definitions
@@ -54,7 +54,7 @@ GENERIC: definitions-changed ( assoc obj -- )
 
 : changed-vocabs ( assoc -- vocabs )
     [ drop word? ] assoc-filter
-    [ drop word-vocabulary dup [ vocab ] when dup ] assoc-map ;
+    [ drop vocabulary>> dup [ vocab ] when dup ] assoc-map ;
 
 : updated-definitions ( -- assoc )
     H{ } clone

core/continuations/continuations-tests.factor

@@ -66,7 +66,7 @@ IN: continuations.tests
 
 [ 1 3 2 ] [ bar ] unit-test
 
-[ t ] [ \ bar word-def "c" get innermost-frame-quot = ] unit-test
+[ t ] [ \ bar def>> "c" get innermost-frame-quot = ] unit-test
 
 [ 1 ] [ "c" get innermost-frame-scan ] unit-test
 

core/cpu/ppc/intrinsics/intrinsics.factor

@@ -438,13 +438,13 @@ IN: cpu.ppc.intrinsics
 } define-intrinsic
 
 \ <tuple> [
-    tuple "layout" get layout-size 2 + cells %allot
+    tuple "layout" get size>> 2 + cells %allot
     ! Store layout
     "layout" get 12 load-indirect
     12 11 cell STW
     ! Zero out the rest of the tuple
     f v>operand 12 LI
-    "layout" get layout-size [ 12 11 rot 2 + cells STW ] each
+    "layout" get size>> [ 12 11 rot 2 + cells STW ] each
     ! Store tagged ptr in reg
     "tuple" get tuple %store-tagged
 ] H{

core/cpu/x86/64/64.factor

@@ -178,7 +178,7 @@ stack-params "__stack_value" c-type set-c-type-reg-class >>
 
 : struct-types&offset ( struct-type -- pairs )
     struct-type-fields [
-        dup slot-spec-type swap slot-spec-offset 2array
+        [ type>> ] [ offset>> ] bi 2array
     ] map ;
 
 : split-struct ( pairs -- seq )

core/cpu/x86/intrinsics/intrinsics.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.accessors arrays cpu.x86.assembler
+USING: accessors alien alien.accessors arrays cpu.x86.assembler
 cpu.x86.allot cpu.x86.architecture cpu.architecture kernel
 kernel.private math math.private namespaces quotations sequences
 words generic byte-arrays hashtables hashtables.private
@@ -290,12 +290,12 @@ IN: cpu.x86.intrinsics
 } define-intrinsic
 
 \ <tuple> [
-    tuple "layout" get layout-size 2 + cells [
+    tuple "layout" get size>> 2 + cells [
         ! Store layout
         "layout" get "scratch" get load-literal
         1 object@ "scratch" operand MOV
         ! Zero out the rest of the tuple
-        "layout" get layout-size [
+        "layout" get size>> [
             2 + object@ f v>operand MOV
         ] each
         ! Store tagged ptr in reg

core/effects/effects.factor

@@ -24,7 +24,7 @@ TUPLE: effect in out terminated? ;
 
 GENERIC: (stack-picture) ( obj -- str )
 M: string (stack-picture) ;
-M: word (stack-picture) word-name ;
+M: word (stack-picture) name>> ;
 M: integer (stack-picture) drop "object" ;
 
 : stack-picture ( seq -- string )
@@ -46,7 +46,7 @@ M: symbol stack-effect drop (( -- symbol )) ;
 
 M: word stack-effect
     { "declared-effect" "inferred-effect" }
-    swap word-props [ at ] curry map [ ] find nip ;
+    swap props>> [ at ] curry map [ ] find nip ;
 
 M: effect clone
     [ in>> clone ] [ out>> clone ] bi <effect> ;

core/generator/fixup/fixup.factor

@@ -88,7 +88,7 @@ TUPLE: rel-fixup arg class type ;
 : rel-fixup ( arg class type -- ) \ rel-fixup boa , ;
 
 : push-4 ( value vector -- )
-    [ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying ] tri
+    [ length ] [ B{ 0 0 0 0 } swap push-all ] [ underlying>> ] tri
     swap set-alien-unsigned-4 ;
 
 M: rel-fixup fixup*
@@ -120,7 +120,7 @@ SYMBOL: literal-table
     >r add-literal r> rt-xt rel-fixup ;
 
 : rel-primitive ( word class -- )
-    >r word-def first r> rt-primitive rel-fixup ;
+    >r def>> first r> rt-primitive rel-fixup ;
 
 : rel-literal ( literal class -- )
     >r add-literal r> rt-literal rel-fixup ;

core/generator/generator.factor

@@ -1,6 +1,6 @@
  ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays assocs classes combinators cpu.architecture
+USING: accessors 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
@@ -20,7 +20,7 @@ SYMBOL: compiled
     } cond ;
 
 : maybe-compile ( word -- )
-    dup compiled? [ drop ] [ queue-compile ] if ;
+    dup compiled>> [ drop ] [ queue-compile ] if ;
 
 SYMBOL: compiling-word
 

core/generic/generic-tests.factor

@@ -144,7 +144,7 @@ M: integer generic-forget-test-1 / ;
 
 [ t ] [
     \ / usage [ word? ] filter
-    [ word-name "generic-forget-test-1/integer" = ] contains?
+    [ name>> "generic-forget-test-1/integer" = ] contains?
 ] unit-test
 
 [ ] [
@@ -153,7 +153,7 @@ M: integer generic-forget-test-1 / ;
 
 [ f ] [
     \ / usage [ word? ] filter
-    [ word-name "generic-forget-test-1/integer" = ] contains?
+    [ name>> "generic-forget-test-1/integer" = ] contains?
 ] unit-test
 
 GENERIC: generic-forget-test-2 ( a b -- c )
@@ -162,7 +162,7 @@ M: sequence generic-forget-test-2 = ;
 
 [ t ] [
     \ = usage [ word? ] filter
-    [ word-name "generic-forget-test-2/sequence" = ] contains?
+    [ name>> "generic-forget-test-2/sequence" = ] contains?
 ] unit-test
 
 [ ] [
@@ -171,7 +171,7 @@ M: sequence generic-forget-test-2 = ;
 
 [ f ] [
     \ = usage [ word? ] filter
-    [ word-name "generic-forget-test-2/sequence" = ] contains?
+    [ name>> "generic-forget-test-2/sequence" = ] contains?
 ] unit-test
 
 GENERIC: generic-forget-test-3 ( a -- b )

core/generic/generic.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: words kernel sequences namespaces assocs hashtables
+USING: accessors words kernel sequences namespaces assocs
-definitions kernel.private classes classes.private
+hashtables definitions kernel.private classes classes.private
 classes.algebra quotations arrays vocabs effects combinators
 sets ;
 IN: generic
@@ -72,7 +72,7 @@ TUPLE: check-method class generic ;
     3tri ; inline
 
 : method-word-name ( class word -- string )
-    word-name "/" rot word-name 3append ;
+    [ name>> ] bi@ "=>" swap 3append ;
 
 PREDICATE: method-body < word
     "method-generic" word-prop >boolean ;
@@ -93,7 +93,7 @@ M: method-body crossref?
     check-method
     [ method-word-props ] 2keep
     method-word-name f <word>
-    [ set-word-props ] keep ;
+    swap >>props ;
 
 : with-implementors ( class generic quot -- )
     [ swap implementors-map get at ] dip call ; inline

core/generic/standard/engines/tuple/tuple.factor

@@ -18,7 +18,7 @@ C: <trivial-tuple-dispatch-engine> trivial-tuple-dispatch-engine
 TUPLE: tuple-dispatch-engine echelons ;
 
 : push-echelon ( class method assoc -- )
-    >r swap dup "layout" word-prop layout-echelon r>
+    >r swap dup "layout" word-prop echelon>> r>
     [ ?set-at ] change-at ;
 
 : echelon-sort ( assoc -- assoc' )
@@ -54,7 +54,7 @@ M: trivial-tuple-dispatch-engine engine>quot
     ] [ ] make ;
 
 : engine-word-name ( -- string )
-    generic get word-name "/tuple-dispatch-engine" append ;
+    generic get name>> "/tuple-dispatch-engine" append ;
 
 PREDICATE: engine-word < word
     "tuple-dispatch-generic" word-prop generic? ;

core/generic/standard/standard-tests.factor

@@ -287,7 +287,7 @@ M: sbuf no-stack-effect-decl ;
 
 [ ] [ \ no-stack-effect-decl see ] unit-test
 
-[ ] [ \ no-stack-effect-decl word-def . ] unit-test
+[ ] [ \ no-stack-effect-decl def>> . ] unit-test
 
 ! Cross-referencing with generic words
 TUPLE: xref-tuple-1 ;

core/growable/growable-docs.factor

@@ -7,31 +7,17 @@ ARTICLE: "growable" "Resizable sequence implementation"
 $nl
 "There is a resizable sequence mixin:"
 { $subsection growable }
-"This mixin implements the sequence protocol in terms of a growable protocol:"
+"This mixin implements the sequence protocol by assuming the object has two specific slots:"
-{ $subsection underlying }
+{ $list
-{ $subsection set-underlying }
+    { { $snippet "length" } " - the fill pointer (number of occupied elements in the underlying storage)" }
-{ $subsection set-fill }
+    { { $snippet "underlying" } " - the underlying storage" }
+}
 "The underlying sequence must implement a generic word:"
 { $subsection resize }
-{ $link "vectors" } " and " { $link "sbufs" } " are implemented using the resizable sequence facility." ;
+{ $link "vectors" } ", " { $link "byte-vectors" } " and " { $link "sbufs" } " are implemented using the resizable sequence facility." ;
 
 ABOUT: "growable"
 
-HELP: set-fill
-{ $values { "n" "a new fill pointer" } { "seq" growable } }
-{ $contract "Sets the fill pointer (number of occupied elements in the underlying storage) of a resizable sequence." }
-{ $side-effects "seq" }
-{ $warning "This word is not safe. Changing the fill pointer to a negative value, or a value higher than the underlying sequence length can lead to memory corruption. User code should use " { $link set-length } " instead." } ;
-
-HELP: underlying
-{ $values { "seq" growable } { "underlying" "the underlying sequence" } }
-{ $contract "Outputs the underlying storage of a resizable sequence." } ;
-
-HELP: set-underlying
-{ $values { "underlying" sequence } { "seq" growable } }
-{ $contract "Modifies the underlying storage of a resizable sequence." }
-{ $warning "This word is not safe. Setting an underlying sequence shorter than the fill pointer can lead to memory corruption." } ;
-
 HELP: capacity
 { $values { "seq" "a vector or string buffer" } { "n" "the capacity of the sequence" } }
 { $description "Outputs the number of elements the sequence can hold without growing." } ;

core/growable/growable.factor

@@ -1,24 +1,24 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 
 ! Some low-level code used by vectors and string buffers.
-USING: kernel kernel.private math math.private
+USING: accessors kernel kernel.private math math.private
 sequences sequences.private ;
 IN: growable
 
 MIXIN: growable
-GENERIC: underlying ( seq -- underlying )
-GENERIC: set-underlying ( underlying seq -- )
-GENERIC: set-fill ( n seq -- )
 
-M: growable nth-unsafe underlying nth-unsafe ;
+SLOT: length
+SLOT: underlying
 
-M: growable set-nth-unsafe underlying set-nth-unsafe ;
+M: growable length length>> ;
+M: growable nth-unsafe underlying>> nth-unsafe ;
+M: growable set-nth-unsafe underlying>> set-nth-unsafe ;
 
-: capacity ( seq -- n ) underlying length ; inline
+: capacity ( seq -- n ) underlying>> length ; inline
 
 : expand ( len seq -- )
-    [ underlying resize ] keep set-underlying ; inline
+    [ resize ] change-underlying drop ; inline
 
 : contract ( len seq -- )
     [ length ] keep
@@ -35,7 +35,7 @@ M: growable set-length ( n seq -- )
     ] [
         2dup capacity > [ 2dup expand ] when
     ] if
-    >r >fixnum r> set-fill ;
+    swap >fixnum >>length drop ;
 
 : new-size ( old -- new ) 1+ 3 * ; inline
 
@@ -44,20 +44,19 @@ M: growable set-length ( n seq -- )
     2dup length >= [
         2dup capacity >= [ over new-size over expand ] when
         >r >fixnum r>
-        2dup >r 1 fixnum+fast r> set-fill
+        2dup swap 1 fixnum+fast >>length drop
     ] [
         >r >fixnum r>
     ] if ; inline
 
 M: growable set-nth ensure set-nth-unsafe ;
 
-M: growable clone ( seq -- newseq )
+M: growable clone (clone) [ clone ] change-underlying ;
-    (clone) dup underlying clone over set-underlying ;
 
 M: growable lengthen ( n seq -- )
     2dup length > [
         2dup capacity > [ over new-size over expand ] when
-        2dup >r >fixnum r> set-fill
+        2dup swap >fixnum >>length drop
     ] when 2drop ;
 
 INSTANCE: growable sequence

core/hashtables/hashtables-docs.factor

@@ -8,7 +8,7 @@ ARTICLE: "hashtables.private" "Hashtable implementation details"
 $nl
 "There are two special objects: the " { $link ((tombstone)) } " marker and the " { $link ((empty)) } " marker. Neither of these markers can be used as hashtable keys."
 $nl
-"The " { $link hash-count } " slot is the number of entries including deleted entries, and " { $link hash-deleted } " is the number of deleted entries."
+"The " { $snippet "count" } " slot is the number of entries including deleted entries, and " { $snippet "deleted" } " is the number of deleted entries."
 { $subsection <hash-array> }
 { $subsection set-nth-pair }
 "If a hashtable's keys are mutated, or if hashing algorithms change, hashtables can be rehashed:"

core/hashtables/hashtables.factor

@@ -1,9 +1,14 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private slots.private math assocs
+USING: accessors arrays kernel kernel.private slots.private math
-math.private sequences sequences.private vectors grouping ;
+assocs math.private sequences sequences.private vectors grouping ;
 IN: hashtables
 
+TUPLE: hashtable
+{ "count" array-capacity }
+{ "deleted" array-capacity }
+{ "array" array } ;
+
 <PRIVATE
 
 : wrap ( i array -- n )
@@ -23,16 +28,16 @@ IN: hashtables
     ] if ; inline
 
 : key@ ( key hash -- array n ? )
-    hash-array 2dup hash@ (key@) ; inline
+    array>> 2dup hash@ (key@) ; inline
 
 : <hash-array> ( n -- array )
     1+ next-power-of-2 4 * ((empty)) <array> ; inline
 
 : init-hash ( hash -- )
-    0 over set-hash-count 0 swap set-hash-deleted ;
+    0 >>count 0 >>deleted drop ; inline
 
 : reset-hash ( n hash -- )
-    swap <hash-array> over set-hash-array init-hash ;
+    swap <hash-array> >>array init-hash ;
 
 : (new-key@) ( key keys i -- keys n empty? )
     3dup swap array-nth dup ((empty)) eq? [
@@ -46,17 +51,17 @@ IN: hashtables
     ] if ; inline
 
 : new-key@ ( key hash -- array n empty? )
-    hash-array 2dup hash@ (new-key@) ; inline
+    array>> 2dup hash@ (new-key@) ; inline
 
 : set-nth-pair ( value key seq n -- )
     2 fixnum+fast [ set-slot ] 2keep
     1 fixnum+fast set-slot ; inline
 
 : hash-count+ ( hash -- )
-    dup hash-count 1+ swap set-hash-count ; inline
+    [ 1+ ] change-count drop ; inline
 
 : hash-deleted+ ( hash -- )
-    dup hash-deleted 1+ swap set-hash-deleted ; inline
+    [ 1+ ] change-deleted drop ; inline
 
 : (set-hash) ( value key hash -- new? )
     2dup new-key@
@@ -67,11 +72,11 @@ IN: hashtables
     swap [ swapd (set-hash) drop ] curry assoc-each ;
 
 : hash-large? ( hash -- ? )
-    [ hash-count 3 fixnum*fast  ]
+    [ count>> 3 fixnum*fast  ]
-    [ hash-array array-capacity ] bi > ;
+    [ array>> array-capacity ] bi > ;
 
 : hash-stale? ( hash -- ? )
-    [ hash-deleted 10 fixnum*fast ] [ hash-count ] bi fixnum> ;
+    [ deleted>> 10 fixnum*fast ] [ count>> ] bi fixnum> ;
 
 : grow-hash ( hash -- )
     [ dup >alist swap assoc-size 1+ ] keep
@@ -98,7 +103,7 @@ M: hashtable at* ( key hash -- value ? )
     key@ [ 3 fixnum+fast slot t ] [ 2drop f f ] if ;
 
 M: hashtable clear-assoc ( hash -- )
-    dup init-hash hash-array [ drop ((empty)) ] change-each ;
+    [ init-hash ] [ array>> [ drop ((empty)) ] change-each ] bi ;
 
 M: hashtable delete-at ( key hash -- )
     tuck key@ [
@@ -109,14 +114,12 @@ M: hashtable delete-at ( key hash -- )
     ] if ;
 
 M: hashtable assoc-size ( hash -- n )
-    dup hash-count swap hash-deleted - ;
+    [ count>> ] [ deleted>> ] bi - ;
 
 : rehash ( hash -- )
-    dup >alist
+    dup >alist >r
-    over hash-array length ((empty)) <array> pick set-hash-array
+    dup clear-assoc
-    0 pick set-hash-count
+    r> (rehash) ;
-    0 pick set-hash-deleted
-    (rehash) ;
 
 M: hashtable set-at ( value key hash -- )
     dup >r (set-hash) [ r> ?grow-hash ] [ r> drop ] if ;
@@ -125,10 +128,10 @@ M: hashtable set-at ( value key hash -- )
     2 <hashtable> [ set-at ] keep ;
 
 M: hashtable >alist
-    hash-array 2 <groups> [ first tombstone? not ] filter ;
+    array>> 2 <groups> [ first tombstone? not ] filter ;
 
 M: hashtable clone
-    (clone) dup hash-array clone over set-hash-array ;
+    (clone) [ clone ] change-array ;
 
 M: hashtable equal?
     over hashtable? [

core/inference/backend/backend.factor

@@ -111,7 +111,7 @@ GENERIC: apply-object ( obj -- )
 M: object apply-object apply-literal ;
 
 M: wrapper apply-object
-    wrapped dup +called+ depends-on apply-literal ;
+    wrapped>> dup +called+ depends-on apply-literal ;
 
 : terminate ( -- )
     terminated? on #terminate node, ;
@@ -400,7 +400,7 @@ TUPLE: missing-effect word ;
         { [ dup inline? ] [ drop f ] }
         { [ dup deferred? ] [ drop f ] }
         { [ dup crossref? not ] [ drop f ] }
-        [ word-def [ [ word? ] [ primitive? not ] bi and ] contains? ]
+        [ def>> [ [ word? ] [ primitive? not ] bi and ] contains? ]
     } cond ;
 
 : ?missing-effect ( word -- )
@@ -429,7 +429,7 @@ TUPLE: missing-effect word ;
         [
             init-inference
             dependencies off
-            dup word-def over dup infer-quot-recursive
+            dup def>> over dup infer-quot-recursive
             end-infer
             finish-word
             current-effect
@@ -492,7 +492,7 @@ M: #return collect-label-info*
 : inline-block ( word -- #label data )
     [
         copy-inference nest-node
-        [ word-def ] [ <inlined-block> ] bi
+        [ def>> ] [ <inlined-block> ] bi
         [ infer-quot-recursive ] 2keep
         #label unnest-node
         dup collect-label-info

core/inference/class/class-tests.factor

@@ -159,7 +159,7 @@ DEFER: blah
         [ dup V{ } eq? [ foo ] when ] dup second dup push define
     ] with-compilation-unit
 
-    \ blah word-def dataflow optimize drop
+    \ blah def>> dataflow optimize drop
 ] unit-test
 
 GENERIC: detect-fx ( n -- n )

core/inference/inference-tests.factor

@@ -271,7 +271,7 @@ DEFER: #1
 : #4 ( a -- ) dup [ drop ] [ dup #4 dup #3 call ] if ;
 : #1 ( a -- ) dup [ dup #4 dup #3 ] [ ] if drop ;
 
-[ \ #4 word-def infer ] must-fail
+[ \ #4 def>> infer ] must-fail
 [ [ #1 ] infer ] must-fail
 
 ! Similar

core/inference/known-words/known-words.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: alien alien.accessors arrays bit-arrays byte-arrays
+USING: accessors alien alien.accessors arrays bit-arrays byte-arrays
 classes sequences.private continuations.private effects
 float-arrays generic hashtables hashtables.private
 inference.state inference.backend inference.dataflow io
@@ -137,7 +137,7 @@ M: object infer-call
 ! Variadic tuple constructor
 \ <tuple-boa> [
     \ <tuple-boa>
-    peek-d value-literal layout-size { tuple } <effect>
+    peek-d value-literal size>> { tuple } <effect>
     make-call-node
 ] "infer" set-word-prop
 

core/inference/transforms/transforms-tests.factor

@@ -31,19 +31,19 @@ C: <color> color
 
 [ 1 2 3 ] [ 1 2 3 <color> cleave-test ] unit-test
 
-[ 1 2 3 ] [ 1 2 3 <color> \ cleave-test word-def call ] unit-test
+[ 1 2 3 ] [ 1 2 3 <color> \ cleave-test def>> call ] unit-test
 
 : 2cleave-test ( a b -- c d e ) { [ 2array ] [ + ] [ - ] } 2cleave ;
 
 [ { 1 2 } 3 -1 ] [ 1 2 2cleave-test ] unit-test
 
-[ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test word-def call ] unit-test
+[ { 1 2 } 3 -1 ] [ 1 2 \ 2cleave-test def>> call ] unit-test
 
 : spread-test ( a b c -- d e f ) { [ sq ] [ neg ] [ recip ] } spread ;
 
 [ 16 -3 1/6 ] [ 4 3 6 spread-test ] unit-test
 
-[ 16 -3 1/6 ] [ 4 3 6 \ spread-test word-def call ] unit-test
+[ 16 -3 1/6 ] [ 4 3 6 \ spread-test def>> call ] unit-test
 
 [ fixnum instance? ] must-infer
 

core/inspector/inspector.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables io kernel assocs math
+USING: accessors arrays generic hashtables io kernel assocs math
 namespaces prettyprint sequences strings io.styles vectors words
 quotations mirrors splitting math.parser classes vocabs refs
 sets sorting ;
@@ -9,7 +9,7 @@ IN: inspector
 GENERIC: summary ( object -- string )
 
 : object-summary ( object -- string )
-    class word-name " instance" append ;
+    class name>> " instance" append ;
 
 M: object summary object-summary ;
 
@@ -24,7 +24,7 @@ M: word summary synopsis ;
 
 M: sequence summary
     [
-        dup class word-name %
+        dup class name>> %
         " with " %
         length #
         " elements" %
@@ -32,7 +32,7 @@ M: sequence summary
 
 M: assoc summary
     [
-        dup class word-name %
+        dup class name>> %
         " with " %
         assoc-size #
         " entries" %

core/io/streams/string/string.factor

@@ -1,8 +1,8 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: io kernel math namespaces sequences sbufs strings
+USING: accessors io kernel math namespaces sequences sbufs
-generic splitting growable continuations destructors
+strings generic splitting continuations destructors
-io.streams.plain io.encodings math.order ;
+io.streams.plain io.encodings math.order growable ;
 IN: io.streams.string
 
 M: growable dispose drop ;
@@ -21,7 +21,7 @@ M: growable stream-flush drop ;
 M: growable stream-read1 dup empty? [ drop f ] [ pop ] if ;
 
 : harden-as ( seq growble-exemplar -- newseq )
-    underlying like ;
+    underlying>> like ;
 
 : growable-read-until ( growable n -- str )
     >fixnum dupd tail-slice swap harden-as dup reverse-here ;

core/io/styles/styles-docs.factor

@@ -94,7 +94,7 @@ HELP: font-style
 { $description "Character style. Font style, one of " { $link plain } ", " { $link bold } ", " { $link italic } ", or " { $link bold-italic } "." }
 { $examples
     "This example outputs text in all three styles:"
-    { $code "{ plain bold italic bold-italic }\n[ [ word-name ] keep font-style associate format nl ] each" }
+    { $code "{ plain bold italic bold-italic }\n[ [ name>> ] keep font-style associate format nl ] each" }
 }  ;
 
 HELP: presented

core/kernel/kernel.factor

@@ -197,8 +197,16 @@ M: callstack clone (clone) ;
 PRIVATE>
 
 ! Deprecated
+GENERIC: delegate ( obj -- delegate )
+
+M: tuple delegate 2 slot ;
+
 M: object delegate drop f ;
 
+GENERIC: set-delegate ( delegate tuple -- )
+
+M: tuple set-delegate 2 set-slot ;
+
 GENERIC# get-slots 1 ( tuple slots -- ... )
 
 GENERIC# set-slots 1 ( ... tuple slots -- )

core/lexer/lexer.factor

@@ -71,7 +71,7 @@ ERROR: unexpected want got ;
 GENERIC: expected>string ( obj -- str )
 
 M: f expected>string drop "end of input" ;
-M: word expected>string word-name ;
+M: word expected>string name>> ;
 M: string expected>string ;
 
 M: unexpected error.

core/math/bitfields/bitfields-tests.factor

@@ -14,4 +14,4 @@ IN: math.bitfields.tests
 
 [ 3 ] [ foo ] unit-test
 [ 3 ] [ { a b } flags ] unit-test
-[ t ] [ \ foo compiled? ] unit-test
+[ t ] [ \ foo compiled>> ] unit-test

core/math/math-docs.factor

@@ -302,11 +302,11 @@ HELP: fp-nan?
 { $values { "x" real } { "?" "a boolean" } }
 { $description "Tests if " { $snippet "x" } " is an IEEE Not-a-Number value. While " { $snippet "x" } " can be any real number, this word will only ever yield true if " { $snippet "x" } " is a " { $link float } "." } ;
 
-HELP: real-part ( z -- x )
+HELP: real-part
 { $values { "z" number } { "x" real } }
 { $description "Outputs the real part of a complex number. This acts as the identity on real numbers." } ;
 
-HELP: imaginary-part ( z -- y )
+HELP: imaginary-part
 { $values { "z" number } { "y" real } }
 { $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." } ;
 

core/math/math.factor

@@ -8,6 +8,12 @@ GENERIC: >bignum ( x -- n ) foldable
 GENERIC: >integer ( x -- n ) foldable
 GENERIC: >float ( x -- y ) foldable
 
+GENERIC: numerator ( a/b -- a )
+GENERIC: denominator ( a/b -- b )
+
+GENERIC: real-part ( z -- x )
+GENERIC: imaginary-part ( z -- y )
+
 MATH: number= ( x y -- ? ) foldable
 
 M: object number= 2drop f ;

core/mirrors/mirrors.factor

@@ -26,10 +26,10 @@ M: mirror at*
 
 M: mirror set-at ( val key mirror -- )
     [ nip object>> ] [ drop ] [ slots>> slot-named ] 2tri dup [
-        dup writer>> [
+        dup read-only>> [
-            nip offset>> set-slot
-        ] [
             drop immutable-slot
+        ] [
+            nip offset>> set-slot
         ] if
     ] [
         drop no-such-slot

core/optimizer/def-use/def-use-tests.factor

@@ -91,7 +91,7 @@ namespaces assocs kernel sequences math tools.test words sets ;
     {
         [ swapd * -rot p2 +@ ]
         [ 2swap [ swapd * -rot p2 +@ ] 2keep ]
-    } \ regression-1 word-def kill-set [ member? ] curry map
+    } \ regression-1 def>> kill-set [ member? ] curry map
 ] unit-test
 
 : regression-2 ( x y -- x.y )
@@ -121,6 +121,6 @@ namespaces assocs kernel sequences math tools.test words sets ;
             ] with assoc-each
         ]
     }
-    \ regression-2 word-def kill-set
+    \ regression-2 def>> kill-set
     [ member? ] curry map
 ] unit-test

core/optimizer/inlining/inlining.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic assocs inference inference.class
+USING: accessors arrays generic assocs inference inference.class
 inference.dataflow inference.backend inference.state io kernel
 math namespaces sequences vectors words quotations hashtables
 combinators classes classes.algebra generic.math
@@ -37,7 +37,7 @@ DEFER: (flat-length)
         ! not inline
         { [ dup inline? not ] [ drop 1 ] }
         ! inline
-        [ dup dup set word-def (flat-length) ]
+        [ dup dup set def>> (flat-length) ]
     } cond ;
 
 : (flat-length) ( seq -- n )
@@ -51,7 +51,7 @@ DEFER: (flat-length)
     ] map sum ;
 
 : flat-length ( seq -- n )
-    [ word-def (flat-length) ] with-scope ;
+    [ def>> (flat-length) ] with-scope ;
 
 ! Single dispatch method inlining optimization
 : node-class# ( node n -- class )
@@ -201,7 +201,7 @@ DEFER: (flat-length)
 
 : splice-word-def ( #call word -- node )
     dup +inlined+ depends-on
-    dup word-def swap 1array splice-quot ;
+    dup def>> swap 1array splice-quot ;
 
 : optimistic-inline ( #call -- node )
     dup node-param over node-history memq? [

core/optimizer/known-words/known-words.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: optimizer.known-words
-USING: alien arrays generic hashtables inference.dataflow
+USING: accessors alien arrays generic hashtables inference.dataflow
 inference.class kernel assocs math math.order math.private
 kernel.private sequences words parser vectors strings sbufs io
 namespaces assocs quotations sequences.private io.binary
@@ -14,7 +14,7 @@ sequences.private combinators byte-arrays byte-vectors ;
 { <tuple> <tuple-boa> } [
     [
         dup node-in-d peek node-literal
-        dup tuple-layout? [ layout-class ] [ drop tuple ] if
+        dup tuple-layout? [ class>> ] [ drop tuple ] if
         1array f
     ] "output-classes" set-word-prop
 ] each

core/optimizer/math/math.factor

@@ -256,7 +256,7 @@ optimizer.math.partial generic.standard system accessors ;
     alien-signed-8
     alien-unsigned-8
 } [
-    dup word-name {
+    dup name>> {
         {
             [ "alien-signed-" ?head ]
             [ string>number 8 * 1- 2^ dup neg swap 1- [a,b] ]

core/optimizer/math/partial/partial.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private math math.private words
+USING: accessors kernel kernel.private math math.private words
 sequences parser namespaces assocs quotations arrays
 generic generic.math hashtables effects ;
 IN: optimizer.math.partial
@@ -40,16 +40,16 @@ PREDICATE: math-partial < word
 <<
 : integer-op-combinator ( triple -- word )
     [
-        [ second word-name % "-" % ]
+        [ second name>> % "-" % ]
-        [ third word-name % "-op" % ]
+        [ third name>> % "-op" % ]
         bi
     ] "" make in get lookup ;
 
 : integer-op-word ( triple fix-word big-word -- word )
     [
         drop
-        word-name "fast" tail? >r
+        name>> "fast" tail? >r
-        [ "-" % ] [ word-name % ] interleave
+        [ "-" % ] [ name>> % ] interleave
         r> [ "-fast" % ] when
     ] "" make in get create ;
 
@@ -86,7 +86,7 @@ PREDICATE: math-partial < word
     { fixnum bignum float }
     [ [ dup 3array ] [ swap method ] 2bi ] with { } map>assoc
     [ nip ] assoc-filter
-    [ word-def peek ] assoc-map % ;
+    [ def>> peek ] assoc-map % ;
 
 SYMBOL: math-ops
 

core/optimizer/optimizer-tests.factor

@@ -17,7 +17,7 @@ IN: optimizer.tests
 GENERIC: xyz ( obj -- obj )
 M: array xyz xyz ;
 
-[ t ] [ \ xyz compiled? ] unit-test
+[ t ] [ \ xyz compiled>> ] unit-test
 
 ! Test predicate inlining
 : pred-test-1
@@ -102,7 +102,7 @@ TUPLE: pred-test ;
 ! regression
 GENERIC: void-generic ( obj -- * )
 : breakage ( -- * ) "hi" void-generic ;
-[ t ] [ \ breakage compiled? ] unit-test
+[ t ] [ \ breakage compiled>> ] unit-test
 [ breakage ] must-fail
 
 ! regression
@@ -133,7 +133,7 @@ GENERIC: void-generic ( obj -- * )
 ! compiling <tuple> with a non-literal class failed
 : <tuple>-regression ( class -- tuple ) <tuple> ;
 
-[ t ] [ \ <tuple>-regression compiled? ] unit-test
+[ t ] [ \ <tuple>-regression compiled>> ] unit-test
 
 GENERIC: foozul ( a -- b )
 M: reversed foozul ;
@@ -247,7 +247,7 @@ TUPLE: silly-tuple a b ;
 : node-successor-f-bug ( x -- * )
     [ 3 throw ] [ empty-compound ] compose [ 3 throw ] if ;
 
-[ t ] [ \ node-successor-f-bug compiled? ] unit-test
+[ t ] [ \ node-successor-f-bug compiled>> ] unit-test
 
 [ ] [ [ new ] dataflow optimize drop ] unit-test
 
@@ -271,7 +271,7 @@ TUPLE: silly-tuple a b ;
         ] if
     ] if ;
 
-[ t ] [ \ lift-throw-tail-regression compiled? ] unit-test
+[ t ] [ \ lift-throw-tail-regression compiled>> ] unit-test
 [ 3 "an integer" ] [ 3 lift-throw-tail-regression ] unit-test
 [ "hi" "a string" ] [ "hi" lift-throw-tail-regression ] unit-test
 
@@ -309,7 +309,7 @@ M: integer generic-inline-test ;
 
 ! Inlining all of the above should only take two passes
 [ { t f } ] [
-    \ generic-inline-test-1 word-def dataflow
+    \ generic-inline-test-1 def>> dataflow
     [ optimize-1 , optimize-1 , drop ] { } make
 ] unit-test
 
@@ -322,7 +322,7 @@ HINTS: recursive-inline-hang array ;
 : recursive-inline-hang-1 ( -- a )
     { } recursive-inline-hang ;
 
-[ t ] [ \ recursive-inline-hang-1 compiled? ] unit-test
+[ t ] [ \ recursive-inline-hang-1 compiled>> ] unit-test
 
 DEFER: recursive-inline-hang-3
 

core/optimizer/specializers/specializers.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays generic hashtables kernel kernel.private math
+USING: accessors arrays generic hashtables kernel kernel.private
-namespaces sequences vectors words strings layouts combinators
+math namespaces sequences vectors words strings layouts
-sequences.private classes generic.standard
+combinators sequences.private classes generic.standard
 generic.standard.engines assocs ;
 IN: optimizer.specializers
 
@@ -51,7 +51,7 @@ IN: optimizer.specializers
     ] [ drop f ] if ;
 
 : specialized-def ( word -- quot )
-    dup word-def swap {
+    dup def>> swap {
         { [ dup standard-method? ] [ specialize-method ] }
         {
             [ dup "specializer" word-prop ]

core/parser/parser.factor

@@ -81,7 +81,7 @@ M: no-word-error summary
     dup no-word-error boa
     swap words-named [ forward-reference? not ] filter
     word-restarts throw-restarts
-    dup word-vocabulary (use+) ;
+    dup vocabulary>> (use+) ;
 
 : check-forward ( str word -- word/f )
     dup forward-reference? [

core/prettyprint/backend/backend.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays byte-arrays byte-vectors bit-arrays generic
+USING: accessors arrays byte-arrays byte-vectors bit-arrays generic
 hashtables io assocs kernel math namespaces sequences strings
 sbufs io.styles vectors words prettyprint.config
 prettyprint.sections quotations io io.files math.parser effects
@@ -37,7 +37,7 @@ M: effect pprint* effect>string "(" swap ")" 3append text ;
     ] keep ;
 
 : word-name* ( word -- str )
-    word-name "( no name )" or ;
+    name>> "( no name )" or ;
 
 : pprint-word ( word -- )
     dup record-vocab
@@ -117,7 +117,7 @@ M: pathname pprint*
 : check-recursion ( obj quot -- )
     nesting-limit? [
         drop
-        "~" over class word-name "~" 3append
+        "~" over class name>> "~" 3append
         swap present-text
     ] [
         over recursion-check get memq? [
@@ -166,7 +166,7 @@ M: curry >pprint-sequence ;
 M: compose >pprint-sequence ;
 M: hashtable >pprint-sequence >alist ;
 M: tuple >pprint-sequence tuple>array ;
-M: wrapper >pprint-sequence wrapped 1array ;
+M: wrapper >pprint-sequence wrapped>> 1array ;
 M: callstack >pprint-sequence callstack>array ;
 
 GENERIC: pprint-narrow? ( obj -- ? )
@@ -190,19 +190,19 @@ M: tuple pprint-narrow? drop t ;
 M: object pprint* pprint-object ;
 
 M: curry pprint*
-    dup curry-quot callable? [ pprint-object ] [
+    dup quot>> callable? [ pprint-object ] [
         "( invalid curry )" swap present-text
     ] if ;
 
 M: compose pprint*
-    dup compose-first over compose-second [ callable? ] both?
+    dup [ first>> callable? ] [ second>> callable? ] bi and
     [ pprint-object ] [
         "( invalid compose )" swap present-text
     ] if ;
 
 M: wrapper pprint*
-    dup wrapped word? [
+    dup wrapped>> word? [
-        <block \ \ pprint-word wrapped pprint-word block>
+        <block \ \ pprint-word wrapped>> pprint-word block>
     ] [
         pprint-object
     ] if ;

core/prettyprint/prettyprint.factor

@@ -99,7 +99,7 @@ SYMBOL: ->
 "word-style" set-word-prop
 
 : remove-step-into ( word -- )
-    building get dup empty? [ drop ] [ nip pop wrapped ] if , ;
+    building get dup empty? [ drop ] [ nip pop wrapped>> ] if , ;
 
 : (remove-breakpoints) ( quot -- newquot )
     [
@@ -139,7 +139,7 @@ GENERIC: see ( defspec -- )
     [ H{ { font-style italic } } styled-text ] when* ;
 
 : seeing-word ( word -- )
-    word-vocabulary pprinter-in set ;
+    vocabulary>> pprinter-in set ;
 
 : definer. ( defspec -- )
     definer drop pprint-word ;
@@ -214,7 +214,7 @@ GENERIC: declarations. ( obj -- )
 M: object declarations. drop ;
 
 : declaration. ( word prop -- )
-    tuck word-name word-prop [ pprint-word ] [ drop ] if ;
+    tuck name>> word-prop [ pprint-word ] [ drop ] if ;
 
 M: word declarations.
     {

core/prettyprint/sections/sections.factor

@@ -20,7 +20,7 @@ TUPLE: pprinter last-newline line-count indent ;
 : <pprinter> ( -- pprinter ) 0 1 0 pprinter boa ;
 
 : record-vocab ( word -- )
-    word-vocabulary [ pprinter-use get conjoin ] when* ;
+    vocabulary>> [ pprinter-use get conjoin ] when* ;
 
 ! Utility words
 : line-limit? ( -- ? )

core/quotations/quotations.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays sequences sequences.private
+USING: accessors arrays sequences sequences.private
 kernel kernel.private math assocs quotations.private
 slots.private ;
 IN: quotations
@@ -12,16 +12,16 @@ M: curry call dup 3 slot swap 4 slot call ;
 M: compose call dup 3 slot swap 4 slot slip call ;
 
 M: wrapper equal?
-    over wrapper? [ [ wrapped ] bi@ = ] [ 2drop f ] if ;
+    over wrapper? [ [ wrapped>> ] bi@ = ] [ 2drop f ] if ;
 
 UNION: callable quotation curry compose ;
 
 M: callable equal?
     over callable? [ sequence= ] [ 2drop f ] if ;
 
-M: quotation length quotation-array length ;
+M: quotation length array>> length ;
 
-M: quotation nth-unsafe quotation-array nth-unsafe ;
+M: quotation nth-unsafe array>> nth-unsafe ;
 
 : >quotation ( seq -- quot )
     >array array>quotation ; inline
@@ -38,28 +38,23 @@ M: object literalize ;
 
 M: wrapper literalize <wrapper> ;
 
-M: curry length curry-quot length 1+ ;
+M: curry length quot>> length 1+ ;
 
 M: curry nth
-    over zero? [
+    over zero? [ nip obj>> literalize ] [ >r 1- r> quot>> nth ] if ;
-        nip curry-obj literalize
-    ] [
-        >r 1- r> curry-quot nth
-    ] if ;
 
 INSTANCE: curry immutable-sequence
 
 M: compose length
-    [ compose-first length ]
+    [ first>> length ] [ second>> length ] bi + ;
-    [ compose-second length ] bi + ;
 
-M: compose virtual-seq compose-first ;
+M: compose virtual-seq first>> ;
 
 M: compose virtual@
-    2dup compose-first length < [
+    2dup first>> length < [
-        compose-first
+        first>>
     ] [
-        [ compose-first length - ] [ compose-second ] bi
+        [ first>> length - ] [ second>> ] bi
     ] if ;
 
 INSTANCE: compose virtual-sequence

core/sbufs/sbufs.factor

@@ -1,9 +1,13 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math strings sequences.private sequences strings
+USING: accessors kernel math strings sequences.private sequences
-growable strings.private ;
+strings growable strings.private ;
 IN: sbufs
 
+TUPLE: sbuf
+{ "underlying" string }
+{ "length" array-capacity } ;
+
 <PRIVATE
 
 : string>sbuf ( string length -- sbuf )
@@ -14,9 +18,10 @@ PRIVATE>
 : <sbuf> ( n -- sbuf ) 0 <string> 0 string>sbuf ; inline
 
 M: sbuf set-nth-unsafe
-    underlying >r >r >fixnum r> >fixnum r> set-string-nth ;
+    [ >fixnum ] [ >fixnum ] [ underlying>> ] tri* set-string-nth ;
 
-M: sbuf new-sequence drop [ 0 <string> ] keep >fixnum string>sbuf ;
+M: sbuf new-sequence
+    drop [ 0 <string> ] [ >fixnum ] bi string>sbuf ;
 
 : >sbuf ( seq -- sbuf ) SBUF" " clone-like ; inline
 
@@ -35,8 +40,8 @@ M: string new-resizable drop <sbuf> ;
 M: string like
     drop dup string? [
         dup sbuf? [
-            dup length over underlying length number= [
+            dup length over underlying>> length number= [
-                underlying dup reset-string-hashcode
+                underlying>> dup reset-string-hashcode
             ] [
                 >string
             ] if

core/slots/deprecated/deprecated.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel kernel.private math namespaces
+USING: accessors arrays kernel kernel.private math namespaces
 sequences strings words effects generic generic.standard
 classes slots.private combinators slots ;
 IN: slots.deprecated
@@ -21,7 +21,7 @@ PREDICATE: slot-reader < word "reading" word-prop >boolean ;
         [ set-reader-props ] 2keep
         dup slot-spec-offset
         over slot-spec-reader
-        rot slot-spec-type reader-quot
+        rot slot-spec-class reader-quot
         define-slot-word
     ] [
         2drop
@@ -62,7 +62,7 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
     >r [ swap "set-" % % "-" % % ] "" make r> create ;
 
 : (simple-slot-word) ( class name -- class name vocab )
-    over word-vocabulary >r >r word-name r> r> ;
+    over vocabulary>> >r >r name>> r> r> ;
 
 : simple-reader-word ( class name -- word )
     (simple-slot-word) reader-word ;
@@ -70,26 +70,8 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
 : simple-writer-word ( class name -- word )
     (simple-slot-word) writer-word ;
 
-: short-slot ( class name # -- spec )
+: deprecated-slots ( class slot-specs -- slot-specs' )
-    >r object bootstrap-word over r> f f <slot-spec>
+    [
-    2over simple-reader-word over set-slot-spec-reader
+        2dup name>> simple-reader-word >>reader
-    -rot simple-writer-word over set-slot-spec-writer ;
+        2dup name>> simple-writer-word >>writer
-
+    ] map nip ;
-: long-slot ( spec # -- spec )
-    >r [ dup array? [ first2 create ] when ] map first4 r>
-    -rot <slot-spec> ;
-
-: simple-slots ( class slots base -- specs )
-    over length [ + ] with map [
-        {
-            { [ over not ] [ 2drop f ] }
-            { [ over string? ] [ >r dupd r> short-slot ] }
-            { [ over array? ] [ long-slot ] }
-        } cond
-    ] 2map sift nip ;
-
-: slot-of-reader ( reader specs -- spec/f )
-    [ slot-spec-reader eq? ] with find nip ;
-
-: slot-of-writer ( writer specs -- spec/f )
-    [ slot-spec-writer eq? ] with find nip ;

core/slots/slots-docs.factor

@@ -92,11 +92,11 @@ HELP: slot-spec
 $nl
 "The slots of a slot specification are:"
 { $list
-    { { $link slot-spec-type } " - a " { $link class } " declaring the set of possible values for the slot." }
+    { { $snippet "name" } " - a " { $link string } " identifying the slot." }
-    { { $link slot-spec-name } " - a " { $link string } " identifying the slot." }
+    { { $snippet "offset" } " - an " { $link integer } " offset specifying where the slot value is stored inside instances of the relevant class. This is an implementation detail." }
-    { { $link slot-spec-offset } " - an " { $link integer } " offset specifying where the slot value is stored inside instances of the relevant class. This is an implementation detail." }
+    { { $snippet "class" } " - a " { $link class } " declaring the set of possible values for the slot." }
-    { { $link slot-spec-reader } " - a " { $link word } " for reading the value of this slot." }
+    { { $snippet "initial" } " - an initial value for the slot." }
-    { { $link slot-spec-writer } " - a " { $link word } " for writing the value of this slot." }
+    { { $snippet "read-only" } " - a boolean indicating whether the slot is read only, or can be written to." }
 } } ;
 
 HELP: define-typecheck
@@ -111,7 +111,7 @@ HELP: define-typecheck
     }
     "It checks if the top of the stack is an instance of " { $snippet "class" } ", and if so, executes the quotation. Delegation is respected."
 }
-{ $notes "This word is used internally to wrap low-level code that does not do type-checking in safe user-visible words. For example, see how " { $link word-name } " is implemented." } ;
+{ $notes "This word is used internally to wrap unsafe low-level code in a type-checking stub." } ;
 
 HELP: define-slot-word
 { $values { "class" class } { "slot" "a positive integer" } { "word" word } { "quot" quotation } }

core/slots/slots-tests.factor

@@ -0,0 +1,18 @@
+IN: slots.tests
+USING: math accessors slots strings generic.standard kernel tools.test ;
+
+TUPLE: r/w-test foo ;
+
+TUPLE: r/o-test { "foo" read-only: t } ;
+
+[ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with
+
+TUPLE: decl-test { "foo" integer } ;
+
+[ decl-test new 1.0 >>foo ] [ bad-slot-value? ] must-fail-with
+
+TUPLE: hello length ;
+
+[ 3 ] [ "xyz" length>> ] unit-test
+
+[ "xyz" 4 >>length ] [ no-method? ] must-fail-with

core/slots/slots.factor

@@ -2,12 +2,14 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel kernel.private math namespaces
 sequences strings words effects generic generic.standard
-classes slots.private combinators accessors ;
+classes slots.private combinators accessors words ;
 IN: slots
 
-TUPLE: slot-spec type name offset reader writer ;
+TUPLE: slot-spec name offset class initial read-only reader writer ;
 
-C: <slot-spec> slot-spec
+: <slot-spec> ( -- slot-spec )
+    slot-spec new
+        object bootstrap-word >>class ;
 
 : define-typecheck ( class generic quot -- )
     [
@@ -15,9 +17,13 @@ C: <slot-spec> slot-spec
         create-method
     ] dip define ;
 
-: define-slot-word ( class slot word quot -- )
+: define-slot-word ( class offset word quot -- )
     rot >fixnum prefix define-typecheck ;
 
+: create-accessor ( name effect -- word )
+    >r "accessors" create dup r>
+    "declared-effect" set-word-prop ;
+
 : reader-quot ( decl -- quot )
     [
         \ slot ,
@@ -25,15 +31,14 @@ C: <slot-spec> slot-spec
         [ drop ] [ 1array , \ declare , ] if
     ] [ ] make ;
 
-: create-accessor ( name effect -- word )
-    >r "accessors" create dup r>
-    "declared-effect" set-word-prop ;
-
 : reader-word ( name -- word )
     ">>" append (( object -- value )) create-accessor ;
 
-: define-reader ( class slot name decl -- )
+: define-reader ( class slot-spec -- )
-    [ reader-word ] dip reader-quot define-slot-word ;
+    [ offset>> ]
+    [ name>> reader-word ]
+    [ class>> reader-quot ]
+    tri define-slot-word ;
 
 : writer-word ( name -- word )
     "(>>" swap ")" 3append (( value object -- )) create-accessor ;
@@ -50,22 +55,25 @@ ERROR: bad-slot-value value object index ;
         ] if
     ] [ ] make ;
 
-: define-writer ( class slot name decl -- )
+: define-writer ( class slot-spec -- )
-    [ writer-word ] dip writer-quot define-slot-word ;
+    [ offset>> ]
+    [ name>> writer-word ]
+    [ class>> writer-quot ]
+    tri define-slot-word ;
 
 : setter-word ( name -- word )
     ">>" prepend (( object value -- object )) create-accessor ;
 
-: define-setter ( name -- )
+: define-setter ( slot-spec -- )
-    dup setter-word dup deferred? [
+    name>> dup setter-word dup deferred? [
         [ \ over , swap writer-word , ] [ ] make define-inline
     ] [ 2drop ] if ;
 
 : changer-word ( name -- word )
     "change-" prepend (( object quot -- object )) create-accessor ;
 
-: define-changer ( name -- )
+: define-changer ( slot-spec -- )
-    dup changer-word dup deferred? [
+    name>> dup changer-word dup deferred? [
         [
             [ over >r >r ] %
             over reader-word ,
@@ -75,15 +83,63 @@ ERROR: bad-slot-value value object index ;
     ] [ 2drop ] if ;
 
 : define-slot-methods ( class slot-spec -- )
-    {
+    [ define-reader ]
-        [ [ drop ] [ name>> ] bi* define-changer ]
+    [
-        [ [ drop ] [ name>> ] bi* define-setter ]
+        dup read-only>> [ 2drop ] [
-        [ [ offset>> ] [ name>> ] [ type>> ] tri define-reader ]
+            [ define-setter drop ]
-        [ [ offset>> ] [ name>> ] [ type>> ] tri define-writer ]
+            [ define-changer drop ]
-    } 2cleave ;
+            [ define-writer ]
+            2tri
+        ] if
+    ] 2bi ;
 
 : define-accessors ( class specs -- )
     [ define-slot-methods ] with each ;
 
+: define-protocol-slot ( name -- )
+    {
+        [ reader-word drop ]
+        [ writer-word drop ]
+        [ setter-word drop ]
+        [ changer-word drop ]
+    } cleave ;
+
+GENERIC: make-slot ( desc -- slot-spec )
+
+M: string make-slot
+    <slot-spec>
+        swap >>name ;
+
+: peel-off-name ( slot-spec array -- slot-spec array )
+    [ first >>name ] [ rest ] bi ; inline
+
+: peel-off-class ( slot-spec array -- slot-spec array )
+    dup empty? [
+        ! We'd use class? here, but during bootstrap, we sometimes
+        ! create slots whose class hasn't been defined yet.
+        dup first name>> ":" tail? not [
+            [ first >>class ] [ rest ] bi
+        ] when
+    ] unless ;
+
+: peel-off-attributes ( slot-spec array -- slot-spec array )
+    dup empty? [
+        unclip {
+            { initial: [ [ first >>initial ] [ rest ] bi ] }
+            { read-only: [ [ first >>read-only ] [ rest ] bi ] }
+        } case
+    ] unless ;
+
+M: array make-slot
+    <slot-spec>
+        swap
+        peel-off-name
+        peel-off-class
+        [ dup empty? not ] [ peel-off-attributes ] [ ] while drop ;
+
+: make-slots ( slots base -- specs )
+    over length [ + ] with map
+    [ [ make-slot ] dip >>offset ] 2map ;
+
 : slot-named ( name specs -- spec/f )
     [ slot-spec-name = ] with find nip ;

core/sorting/sorting.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math sequences vectors math.order
+USING: accessors arrays kernel math sequences vectors math.order
-sequences sequences.private growable math.order ;
+sequences sequences.private math.order ;
 IN: sorting
 
 DEFER: sort
@@ -34,7 +34,7 @@ DEFER: sort
 : merge ( sorted1 sorted2 quot -- result )
     >r [ [ <iterator> ] bi@ ] 2keep r>
     rot length rot length + <vector>
-    [ (merge) ] keep underlying ; inline
+    [ (merge) ] [ underlying>> ] bi ; inline
 
 : conquer ( first second quot -- result )
     [ tuck >r >r sort r> r> sort ] keep merge ; inline

core/strings/strings.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel math.private sequences kernel.private
+USING: accessors kernel math.private sequences kernel.private
 math sequences.private slots.private byte-arrays
 alien.accessors ;
 IN: strings
@@ -30,6 +30,9 @@ M: string hashcode*
     nip dup string-hashcode [ ]
     [ dup rehash-string string-hashcode ] ?if ;
 
+M: string length
+    length>> ;
+
 M: string nth-unsafe
     >r >fixnum r> string-nth ;
 
@@ -38,7 +41,7 @@ M: string set-nth-unsafe
     >r >fixnum >r >fixnum r> r> set-string-nth ;
 
 M: string clone
-    (clone) dup string-aux clone over set-string-aux ;
+    (clone) [ clone ] change-aux ;
 
 M: string resize resize-string ;
 

core/syntax/syntax-docs.factor

@@ -547,8 +547,46 @@ HELP: PREDICATE:
 
 HELP: TUPLE:
 { $syntax "TUPLE: class slots... ;" "TUPLE: class < superclass slots ... ;" }
-{ $values { "class" "a new tuple class to define" } { "slots" "a list of slot names" } }
+{ $values { "class" "a new tuple class to define" } { "slots" "a list of slot specifiers" } }
-{ $description "Defines a new tuple class. The superclass is optional; if left unspecified, it defaults to " { $link tuple } "." } ;
+{ $description "Defines a new tuple class."
+$nl
+"The superclass is optional; if left unspecified, it defaults to " { $link tuple } "."
+$nl
+"Slot specifiers take one of the following three forms:"
+{ $list
+    { { $snippet "name" } " - a slot which can hold any object, with no attributes" }
+    { { $snippet "{ \"name\" attributes... }" } " - a slot which can hold any object, with optional attributes" }
+    { { $snippet "{ \"name\" class attributes... }" } " - a slot specialized to a specific class, with optional attributes" }
+}
+"Slot attributes are lists of slot attribute specifiers followed by values; a slot attribute specifier is one of " { $link initial: } " or " { $link read-only: } "." }
+{ $examples
+    "A simple tuple class:"
+    { $code "TUPLE: color red green blue ;" }
+    "Declaring slots to be integer-valued:"
+    { $code "TUPLE: color" "{ \"red\" integer }" "{ \"green\" integer }" "{ \"blue\" integer } ;" }
+    "An example mixing short and long slot specifiers:"
+    { $code "TUPLE: person" "{ \"age\" integer initial: 0 }" "{ \"department\" string initial: \"Marketing\" }" "manager ;" }
+} ;
+
+HELP: initial:
+{ $syntax "TUPLE: ... { \"slot\" initial: value } ... ;" }
+{ $values { "slot" "a slot name" } { "value" "any literal" } }
+{ $description "Specifies an initial value for a tuple slot." } ;
+
+HELP: read-only:
+{ $syntax "TUPLE: ... { \"slot\" read-only: ? } ... ;" }
+{ $values { "slot" "a slot name" } { "?" "a boolean" } }
+{ $description "Defines a tuple slot to be read-only. If a tuple has read-only slots, instances of the tuple should only be created by calling " { $link boa } ", instead of " { $link new } ". Using " { $link boa } " is the only way to set the value of a read-only slot." } ;
+
+{ initial: read-only: } related-words
+
+HELP: SLOT:
+{ $syntax "SLOT: name" }
+{ $values { "name" "a slot name" } }
+{ $description "Defines a protocol slot; that is, defines the accessor words for a slot named " { $snippet "slot" } " without associating it with any specific tuple." }
+{ $notes
+    "Protocol slots are used where the implementation of a superclass needs to assume that each subclass defines certain slots, however the slots of each subclass are potentially declared with different class specializers, thus preventing the slots from being defined in the superclass."
+} ;
 
 HELP: ERROR:
 { $syntax "ERROR: class slots... ;" }

core/syntax/syntax.factor

@@ -8,7 +8,7 @@ generic.standard generic.math generic.parser classes io.files
 vocabs float-arrays classes.parser classes.union
 classes.intersection classes.mixin classes.predicate
 classes.singleton classes.tuple.parser compiler.units
-combinators debugger effects.parser ;
+combinators debugger effects.parser slots ;
 IN: bootstrap.syntax
 
 ! These words are defined as a top-level form, instead of with
@@ -166,6 +166,10 @@ IN: bootstrap.syntax
         parse-tuple-definition define-tuple-class
     ] define-syntax
 
+    "SLOT:" [
+        scan define-protocol-slot
+    ] define-syntax
+
     "C:" [
         CREATE-WORD
         scan-word check-tuple-class
@@ -208,4 +212,8 @@ IN: bootstrap.syntax
             not-in-a-method-error
         ] if
     ] define-syntax
+    
+    "initial:" "syntax" lookup define-symbol
+    
+    "read-only:" "syntax" lookup define-symbol
 ] with-compilation-unit

core/vectors/vectors.factor

@@ -3,6 +3,10 @@
 USING: arrays kernel math sequences sequences.private growable ;
 IN: vectors
 
+TUPLE: vector
+{ "underlying" array }
+{ "length" array-capacity } ;
+
 <PRIVATE
 
 : array>vector ( array length -- vector )

core/words/words-docs.factor

@@ -11,10 +11,7 @@ $nl
 "Parsing words add definitions to the current vocabulary. When a source file is being parsed, the current vocabulary is initially set to " { $vocab-link "scratchpad" } ". The current vocabulary may be changed with the " { $link POSTPONE: IN: } " parsing word (see " { $link "vocabulary-search" } ")."
 { $subsection create }
 { $subsection create-in }
-{ $subsection lookup }
+{ $subsection lookup } ;
-"Words can output their name and vocabulary:"
-{ $subsection word-name }
-{ $subsection word-vocabulary } ;
 
 ARTICLE: "uninterned-words" "Uninterned words"
 "A word that is not a member of any vocabulary is said to be " { $emphasis "uninterned" } "."
@@ -103,8 +100,6 @@ ARTICLE: "word-props" "Word properties"
 "Each word has a hashtable of properties."
 { $subsection word-prop }
 { $subsection set-word-prop }
-{ $subsection word-props }
-{ $subsection set-word-props }
 "The stack effect of the above two words is designed so that it is most convenient when " { $snippet "name" } " is a literal pushed on the stack right before executing this word."
 $nl
 "The following are some of the properties used by the library:"
@@ -159,9 +154,8 @@ $nl
 } ;
 
 ARTICLE: "word.private" "Word implementation details"
-"Primitive definition accessors:"
+"The " { $snippet "def" } " slot of a word holds a " { $link quotation } " instance that is called when the word is executed."
-{ $subsection word-def }
+$nl
-{ $subsection set-word-def }
 "An " { $emphasis "XT" } " (execution token) is the machine code address of a word:"
 { $subsection word-xt } ;
 
@@ -189,10 +183,6 @@ $nl
 
 ABOUT: "words"
 
-HELP: compiled? ( word -- ? )
-{ $values { "word" word } { "?" "a boolean" } }
-{ $description "Tests if a word has been compiled." } ;
-
 HELP: execute ( word -- )
 { $values { "word" word } }
 { $description "Executes a word." }
@@ -200,26 +190,6 @@ HELP: execute ( word -- )
     { $example "USING: kernel io words ;" "IN: scratchpad" ": twice dup execute execute ;\n: hello \"Hello\" print ;\n\\ hello twice" "Hello\nHello" }
 } ;
 
-HELP: word-props ( word -- props )
-{ $values { "word" word } { "props" "an assoc" } }
-{ $description "Outputs a word's property table." } ;
-
-HELP: set-word-props ( props word -- )
-{ $values { "props" "an assoc" } { "word" word } }
-{ $description "Sets a word's property table." }
-{ $notes "The given assoc must not be a literal, since it will be mutated by future calls to " { $link set-word-prop } "." }
-{ $side-effects "word" } ;
-
-HELP: word-def ( word -- obj )
-{ $values { "word" word } { "obj" object } }
-{ $description "Outputs a word's primitive definition." } ;
-
-HELP: set-word-def ( obj word -- )
-{ $values { "obj" object } { "word" word } }
-{ $description "Sets a word's primitive definition." }
-$low-level-note
-{ $side-effects "word" } ;
-
 HELP: deferred
 { $class-description "The class of deferred words created by " { $link POSTPONE: DEFER: } "." } ;
 

core/words/words-tests.factor

@@ -37,7 +37,7 @@ DEFER: plist-test
 ] with-scope
 
 [ "test-scope" ] [
-    "test-scope" "scratchpad" lookup word-name
+    "test-scope" "scratchpad" lookup name>> 
 ] unit-test
 
 [ t ] [ vocabs array? ] unit-test
@@ -120,7 +120,7 @@ DEFER: x
 [ f ] [ "no-loc-2" "words.tests" lookup where ] unit-test
 
 [ ] [ "IN: words.tests : test-last ( -- ) ;" eval ] unit-test
-[ "test-last" ] [ word word-name ] unit-test
+[ "test-last" ] [ word name>> ] unit-test
 
 ! regression
 SYMBOL: quot-uses-a

core/words/words.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2004, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions graphs assocs kernel kernel.private
+USING: accessors arrays definitions graphs assocs kernel
-slots.private math namespaces sequences strings vectors sbufs
+kernel.private slots.private math namespaces sequences strings
-quotations assocs hashtables sorting words.private vocabs
+vectors sbufs quotations assocs hashtables sorting words.private
-math.order sets ;
+vocabs math.order sets ;
 IN: words
 
 : word ( -- word ) \ word get-global ;
@@ -15,37 +15,36 @@ GENERIC: execute ( word -- )
 M: word execute (execute) ;
 
 M: word <=>
-    [ dup word-name swap word-vocabulary 2array ] compare ;
+    [ [ name>> ] [ vocabulary>> ] bi 2array ] compare ;
 
 M: word definer drop \ : \ ; ;
 
-M: word definition word-def ;
+M: word definition def>> ;
 
 ERROR: undefined ;
 
 PREDICATE: deferred < word ( obj -- ? )
-    word-def [ undefined ] = ;
+    def>> [ undefined ] = ;
 M: deferred definer drop \ DEFER: f ;
 M: deferred definition drop f ;
 
 PREDICATE: symbol < word ( obj -- ? )
-    dup <wrapper> 1array swap word-def sequence= ;
+    [ def>> ] [ [ ] curry ] bi sequence= ;
 M: symbol definer drop \ SYMBOL: f ;
 M: symbol definition drop f ;
 
 PREDICATE: primitive < word ( obj -- ? )
-    word-def [ do-primitive ] tail? ;
+    def>> [ do-primitive ] tail? ;
 M: primitive definer drop \ PRIMITIVE: f ;
 M: primitive definition drop f ;
 
-: word-prop ( word name -- value ) swap word-props at ;
+: word-prop ( word name -- value ) swap props>> at ;
 
-: remove-word-prop ( word name -- )
+: remove-word-prop ( word name -- ) swap props>> delete-at ;
-    swap word-props delete-at ;
 
 : set-word-prop ( word value name -- )
     over
-    [ pick word-props ?set-at swap set-word-props ]
+    [ pick props>> ?set-at >>props drop ]
     [ nip remove-word-prop ] if ;
 
 : reset-props ( word seq -- ) [ remove-word-prop ] with each ;
@@ -53,7 +52,7 @@ M: primitive definition drop f ;
 : lookup ( name vocab -- word ) vocab-words at ;
 
 : target-word ( word -- target )
-    dup word-name swap word-vocabulary lookup ;
+    [ name>> ] [ vocabulary>> ] bi lookup ;
 
 SYMBOL: bootstrapping?
 
@@ -69,7 +68,7 @@ M: word crossref?
     dup "forgotten" word-prop [
         drop f
     ] [
-        word-vocabulary >boolean
+        vocabulary>> >boolean
     ] if ;
 
 GENERIC: compiled-crossref? ( word -- ? )
@@ -88,13 +87,13 @@ M: array (quot-uses) seq-uses ;
 
 M: callable (quot-uses) seq-uses ;
 
-M: wrapper (quot-uses) >r wrapped r> (quot-uses) ;
+M: wrapper (quot-uses) >r wrapped>> r> (quot-uses) ;
 
 : quot-uses ( quot -- assoc )
     global [ H{ } clone [ (quot-uses) ] keep ] bind ;
 
 M: word uses ( word -- seq )
-    word-def quot-uses keys ;
+    def>> quot-uses keys ;
 
 SYMBOL: compiled-crossref
 
@@ -140,7 +139,7 @@ M: object redefined drop ;
     [ ] like
     over unxref
     over redefined
-    over set-word-def
+    >>def
     dup +inlined+ changed-definition
     dup crossref? [ dup xref ] when drop ;
 
@@ -204,7 +203,7 @@ M: word subwords drop f ;
     gensym dup rot define ;
 
 : reveal ( word -- )
-    dup word-name over word-vocabulary dup vocab-words
+    dup [ name>> ] [ vocabulary>> ] bi dup vocab-words
     [ ] [ no-vocab ] ?if
     set-at ;
 
@@ -234,7 +233,7 @@ M: word set-where swap "loc" set-word-prop ;
 M: word forget*
     dup "forgotten" word-prop [ drop ] [
         [ delete-xref ]
-        [ [ word-name ] [ word-vocabulary vocab-words ] bi delete-at ]
+        [ [ name>> ] [ vocabulary>> vocab-words ] bi delete-at ]
         [ t "forgotten" set-word-prop ]
         tri
     ] if ;
@@ -244,6 +243,6 @@ M: word hashcode*
 
 M: word literalize <wrapper> ;
 
-: ?word-name ( word -- name ) dup word? [ word-name ] when ;
+: ?word-name ( word -- name ) dup word? [ name>> ] when ;
 
 : xref-words ( -- ) all-words [ xref ] each ;

extra/alias/alias.factor

@@ -7,7 +7,7 @@ M: alias reset-word
     [ call-next-method ] [ f "alias" set-word-prop ] bi ;
 
 M: alias stack-effect
-    word-def first stack-effect ;
+    def>> first stack-effect ;
 
 : define-alias ( new old -- )
     [ 1quotation define-inline ]

extra/bit-vectors/bit-vectors.factor

@@ -5,15 +5,9 @@ sequences.private growable bit-arrays prettyprint.backend
 parser accessors ;
 IN: bit-vectors
 
-TUPLE: bit-vector underlying fill ;
+TUPLE: bit-vector
-
+{ "underlying" bit-array }
-M: bit-vector underlying underlying>> { bit-array } declare ;
+{ "length" array-capacity } ;
-
-M: bit-vector set-underlying (>>underlying) ;
-
-M: bit-vector length fill>> { array-capacity } declare ;
-
-M: bit-vector set-fill (>>fill) ;
 
 <PRIVATE
 

extra/cpu/8080/emulator/emulator.factor

@@ -512,7 +512,7 @@ SYMBOL: rom-root
   [ " A: " write cpu-a 16 >base 2 CHAR: \s pad-left write ] keep 
   [ " SP: " write cpu-sp 16 >base 4 CHAR: \s pad-left write ] keep 
   [ " cycles: " write cpu-cycles number>string 5 CHAR: \s pad-left write ] keep 
-  [ " " write peek-instruction word-name write " " write ] keep
+  [ " " write peek-instruction name>> write " " write ] keep
   nl drop ;
 
 : cpu*. ( cpu -- )

extra/db/queries/queries.factor

@@ -167,7 +167,7 @@ M: db <query> ( tuple class query -- tuple )
         dup class db-columns [ ", " 0, ]
         [ dup column-name>> 0, 2, ] interleave
         from 0,
-        class word-name 0,
+        class name>> 0,
     ] { { } { } { } } nmake
     >r >r parse-sql 4drop r> r>
     <simple-statement> maybe-make-retryable do-select ;

extra/delegate/delegate.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2007 Daniel Ehrenberg
 ! See http://factorcode.org/license.txt for BSD license.
-USING: parser generic kernel classes words slots assocs
+USING: accessors parser generic kernel classes words slots assocs
 sequences arrays vectors definitions prettyprint
 math hashtables sets macros namespaces ;
 IN: delegate
@@ -35,7 +35,7 @@ M: tuple-class group-words
     define ;
 
 : change-word-prop ( word prop quot -- )
-    rot word-props swap change-at ; inline
+    rot props>> swap change-at ; inline
 
 : register-protocol ( group class quot -- )
     rot \ protocol-consult [ swapd ?set-at ] change-word-prop ;

extra/descriptive/descriptive.factor

@@ -6,7 +6,7 @@ IN: descriptive
 ERROR: descriptive-error args underlying word ;
 
 M: descriptive-error summary
-    word>> "The " swap word-name " word encountered an error."
+    word>> "The " swap name>> " word encountered an error."
     3append ;
 
 <PRIVATE

extra/fjsc/fjsc.factor

@@ -322,10 +322,10 @@ M: number (parse-factor-quotation) ( object -- ast )
   <ast-number> ;
 
 M: symbol (parse-factor-quotation) ( object -- ast )
-  dup >string swap word-vocabulary <ast-identifier> ;
+  dup >string swap vocabulary>> <ast-identifier> ;
 
 M: word (parse-factor-quotation) ( object -- ast )
-  dup word-name swap word-vocabulary <ast-identifier> ;
+  dup name>> swap vocabulary>> <ast-identifier> ;
 
 M: string (parse-factor-quotation) ( object -- ast )
   <ast-string> ;
@@ -346,7 +346,7 @@ M: hashtable (parse-factor-quotation) ( object -- ast )
   ] { } make <ast-hashtable> ;
 
 M: wrapper (parse-factor-quotation) ( object -- ast )
-  wrapped dup word-name swap word-vocabulary <ast-word> ;
+  wrapped dup name>> swap vocabulary>> <ast-word> ;
 
 GENERIC: fjsc-parse ( object -- ast )
 

extra/float-vectors/float-vectors.factor

@@ -5,15 +5,9 @@ sequences.private growable float-arrays prettyprint.backend
 parser accessors ;
 IN: float-vectors
 
-TUPLE: float-vector underlying fill ;
+TUPLE: float-vector
-
+{ "underlying" float-array }
-M: float-vector underlying underlying>> { float-array } declare ;
+{ "length" array-capacity } ;
-
-M: float-vector set-underlying (>>underlying) ;
-
-M: float-vector length fill>> { array-capacity } declare ;
-
-M: float-vector set-fill (>>fill) ;
 
 <PRIVATE
 

extra/furnace/furnace.factor

@@ -31,7 +31,7 @@ IN: furnace
 
 : base-path ( string -- pair )
     dup responder-nesting get
-    [ second class superclasses [ word-name = ] with contains? ] with find nip
+    [ second class superclasses [ name>> = ] with contains? ] with find nip
     [ first ] [ "No such responder: " swap append throw ] ?if ;
 
 : resolve-base-path ( string -- string' )
@@ -46,7 +46,7 @@ IN: furnace
 
 : resolve-template-path ( pair -- path )
     [
-        first2 [ word-vocabulary vocab-path % ] [ "/" % % ] bi*
+        first2 [ vocabulary>> vocab-path % ] [ "/" % % ] bi*
     ] "" make ;
 
 GENERIC: modify-query ( query responder -- query' )

extra/furnace/utilities/utilities.factor

@@ -4,7 +4,7 @@ USING: words kernel sequences splitting ;
 IN: furnace.utilities
 
 : word>string ( word -- string )
-    [ word-vocabulary ] [ word-name ] bi ":" swap 3append ;
+    [ vocabulary>> ] [ name>> ] bi ":" swap 3append ;
 
 : words>strings ( seq -- seq' )
     [ word>string ] map ;

extra/help/help.factor

@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays io kernel namespaces parser prettyprint sequences
+USING: accessors arrays io kernel namespaces parser prettyprint
-words assocs definitions generic quotations effects slots
+sequences words assocs definitions generic quotations effects
-continuations classes.tuple debugger combinators vocabs
+slots continuations classes.tuple debugger combinators vocabs
 help.stylesheet help.topics help.crossref help.markup sorting
 classes vocabs.loader ;
 IN: help
@@ -43,13 +43,13 @@ M: predicate word-help* drop \ $predicate ;
 : all-errors ( -- seq )
     all-words [ error? ] filter sort-articles ;
 
-M: word article-name word-name ;
+M: word article-name name>> ;
 
 M: word article-title
     dup [ parsing-word? ] [ symbol? ] bi or [
-        word-name
+        name>> 
     ] [
-        [ word-name ]
+        [ name>> ]
         [ stack-effect [ effect>string " " prepend ] [ "" ] if* ] bi
         append
     ] if ;

extra/help/lint/lint.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences parser kernel help help.markup help.topics
+USING: accessors sequences parser kernel help help.markup
-words strings classes tools.vocabs namespaces io
+help.topics 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
@@ -27,13 +27,10 @@ IN: help.lint
     ] unless ;
 
 : effect-values ( word -- seq )
-    stack-effect dup effect-in swap effect-out append [
+    stack-effect
-        {
+    [ in>> ] [ out>> ] bi append
-            { [ dup word? ] [ word-name ] }
+    [ (stack-picture) ] map
-            { [ dup integer? ] [ drop "object" ] }
+    prune natural-sort ;
-            { [ dup string? ] [ ] }
-        } cond
-    ] map prune natural-sort ;
 
 : contains-funky-elements? ( element -- ? )
     {

extra/help/markup/markup.factor

@@ -1,9 +1,9 @@
 ! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays definitions generic io kernel assocs hashtables
+USING: accessors arrays definitions generic io kernel assocs
-namespaces parser prettyprint sequences strings io.styles
+hashtables namespaces parser prettyprint sequences strings
-vectors words math sorting splitting classes
+io.styles vectors words math sorting splitting classes slots
-slots vocabs help.stylesheet help.topics vocabs.loader ;
+vocabs help.stylesheet help.topics vocabs.loader ;
 IN: help.markup
 
 ! Simple markup language.
@@ -178,7 +178,7 @@ M: f print-element drop ;
     first dup vocab-name swap ($vocab-link) ;
 
 : $vocabulary ( element -- )
-    first word-vocabulary [
+    first vocabulary>> [
         "Vocabulary" $heading nl dup ($vocab-link)
     ] when* ;
 
@@ -230,7 +230,7 @@ M: f print-element drop ;
 GENERIC: ($instance) ( element -- )
 
 M: word ($instance)
-    dup word-name a/an write bl ($link) ;
+    dup name>> a/an write bl ($link) ;
 
 M: string ($instance)
     dup a/an write bl $snippet ;

extra/html/templates/chloe/syntax/syntax.factor

@@ -38,7 +38,7 @@ MEMO: chloe-name ( string -- name )
 
 : CHLOE-SINGLETON:
     scan-word
-    [ word-name ] [ '[ , singleton-component-tag ] ] bi
+    [ name>> ] [ '[ , singleton-component-tag ] ] bi
     define-chloe-tag ;
     parsing
 
@@ -56,6 +56,6 @@ MEMO: chloe-name ( string -- name )
 
 : CHLOE-TUPLE:
     scan-word
-    [ word-name ] [ '[ , tuple-component-tag ] ] bi
+    [ name>> ] [ '[ , tuple-component-tag ] ] bi
     define-chloe-tag ;
     parsing

extra/inverse/inverse.factor

@@ -80,7 +80,7 @@ UNION: explicit-inverse normal-inverse math-inverse pop-inverse ;
     ] } 1&& ; 
 
 : (flatten) ( quot -- )
-    [ dup flattenable? [ word-def (flatten) ] [ , ] if ] each ;
+    [ dup flattenable? [ def>> (flatten) ] [ , ] if ] each ;
 
  : retain-stack-overflow? ( error -- ? )
     { "kernel-error" 14 f f } = ;

extra/io/unix/sockets/secure/secure-tests.factor

@@ -33,7 +33,7 @@ concurrency.promises byte-arrays locals calendar io.timeouts ;
         "127.0.0.1" "port" get ?promise <inet4> <secure> ascii <client> drop contents
     ] with-secure-context ;
 
-[ ] [ [ class word-name write ] server-test ] unit-test
+[ ] [ [ class name>> write ] server-test ] unit-test
 
 [ "secure" ] [ client-test ] unit-test
 

extra/io/unix/unix.factor

@@ -1,4 +1,4 @@
-USING: system words sequences vocabs.loader ;
+USING: accessors system words sequences vocabs.loader ;
 
 {
     "io.unix.backend"
@@ -10,4 +10,4 @@ USING: system words sequences vocabs.loader ;
     "io.unix.pipes"
 } [ require ] each
 
-"io.unix." os word-name append require
+"io.unix." os name>> append require

extra/koszul/koszul.factor

@@ -41,7 +41,7 @@ SYMBOL: terms
         nip number>string
     ] [
         num-alt.
-        swap [ word-name ] map "." join
+        swap [ name>> ] map "." join
         append
     ] if ;