More tuple declaration work

core/bootstrap/primitives.factor

@@ -67,6 +67,7 @@ bootstrapping? on
     "classes.private"
     "classes.tuple"
     "classes.tuple.private"
+    "classes.predicate"
     "compiler.units"
     "continuations.private"
     "float-arrays"
@@ -117,7 +118,7 @@ bootstrapping? on
     tri ;
 
 : prepare-slots ( slots -- slots' )
-    [ [ dup array? [ first2 create ] when ] map ] map ;
+    [ [ dup pair? [ first2 create ] when ] map ] map ;
 
 : define-builtin-slots ( class slots -- )
     prepare-slots 1 make-slots
@@ -147,6 +148,9 @@ bootstrapping? on
 "byte-array" "byte-arrays" create register-builtin
 "tuple-layout" "classes.tuple.private" create register-builtin
 
+! For predicate classes
+"predicate-instance?" "classes.predicate" create drop
+
 ! We need this before defining c-ptr below
 "f" "syntax" lookup { } define-builtin
 
@@ -256,7 +260,7 @@ define-builtin
     { "hashcode" { "fixnum" "math" } }
     "name"
     "vocabulary"
-    { "def" { "quotation" "quotations" } }
+    { "def" { "quotation" "quotations" } initial: [ ] }
     "props"
     { "compiled" read-only: t }
     { "counter" { "fixnum" "math" } }
@@ -272,9 +276,9 @@ define-builtin
 
 "tuple-layout" "classes.tuple.private" create {
     { "hashcode" { "fixnum" "math" } read-only: t }
-    { "class" { "word" "words" } read-only: t }
+    { "class" { "word" "words" } initial: t read-only: t }
     { "size" { "fixnum" "math" } read-only: t }
-    { "superclasses" { "array" "arrays" } read-only: t }
+    { "superclasses" { "array" "arrays" } initial: { } read-only: t }
     { "echelon" { "fixnum" "math" } read-only: t }
 } define-builtin
 

core/byte-vectors/byte-vectors.factor

@@ -5,8 +5,8 @@ sequences.private growable byte-arrays ;
 IN: byte-vectors
 
 TUPLE: byte-vector
-{ "underlying" byte-array }
+{ underlying byte-array }
-{ "length" array-capacity } ;
+{ length array-capacity } ;
 
 <PRIVATE
 

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

@@ -21,21 +21,21 @@ TUPLE: test-4 < test-3 b ;
 
 [ { "b" } ] [ test-4 "slot-names" word-prop ] unit-test
 
-TUPLE: test-5 { "a" integer } ;
+TUPLE: test-5 { a integer } ;
 
 [ { { "a" integer } } ] [ test-5 "slot-names" word-prop ] unit-test
 
-TUPLE: test-6 < test-5 { "b" integer } ;
+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 } ;
+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 } ;
+TUPLE: test-8 { b integer read-only: t } ;
 
 [ t ] [ "b" test-8 "slots" word-prop slot-named read-only>> ] unit-test
 
@@ -51,11 +51,11 @@ must-fail-with
 [ error>> unexpected-eof? ]
 must-fail-with
 
-[ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { \"slot\" alien } ;" eval ]
+[ "IN: classes.tuple.parser.tests USE: alien TUPLE: foo { slot alien } ;" eval ]
 [ error>> no-initial-value? ]
 must-fail-with
 
-[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { \"slot\" array initial: 5 } ;" eval ]
+[ "IN: classes.tuple.parser.tests USE: arrays TUPLE: foo { slot array initial: 5 } ;" eval ]
 [ error>> bad-initial-value? ]
 must-fail-with
 

core/classes/tuple/parser/parser.factor

@@ -24,6 +24,9 @@ M: invalid-slot-name summary
     drop
     "Invalid slot name" ;
 
+: parse-long-slot-name ( -- )
+    [ scan , \ } parse-until % ] { } make ;
+
 : parse-slot-name ( string/f -- ? )
     #! This isn't meant to enforce any kind of policy, just
     #! to check for mistakes of this form:
@@ -35,7 +38,7 @@ M: invalid-slot-name summary
         { [ dup not ] [ unexpected-eof ] }
         { [ dup { ":" "(" "<" "\"" } member? ] [ invalid-slot-name ] }
         { [ dup ";" = ] [ drop f ] }
-        [ dup "{" = [ drop \ } parse-until >array ] when , t ]
+        [ dup "{" = [ drop parse-long-slot-name ] when , t ]
     } cond ;
 
 : parse-tuple-slots ( -- )

core/generic/generic.factor

@@ -33,7 +33,7 @@ PREDICATE: method-spec < pair
 : specific-method ( class generic -- method/f )
     tuck order min-class dup [ swap method ] [ 2drop f ] if ;
 
-GENERIC: effective-method ( ... generic -- method )
+GENERIC: effective-method ( generic -- method )
 
 : next-method-class ( class generic -- class/f )
     order [ class<= ] with filter reverse dup length 1 =

core/grouping/grouping.factor

@@ -4,7 +4,7 @@ USING: kernel math math.order strings arrays vectors sequences
 accessors ;
 IN: grouping
 
-TUPLE: abstract-groups seq n ;
+TUPLE: abstract-groups { seq read-only: t } { n read-only: t } ;
 
 : check-groups dup 0 <= [ "Invalid group count" throw ] when ; inline
 

core/hashtables/hashtables.factor

@@ -5,9 +5,9 @@ assocs math.private sequences sequences.private vectors grouping ;
 IN: hashtables
 
 TUPLE: hashtable
-{ "count" array-capacity }
+{ count array-capacity }
-{ "deleted" array-capacity }
+{ deleted array-capacity }
-{ "array" array } ;
+{ array array } ;
 
 <PRIVATE
 

core/inference/class/class-tests.factor

@@ -579,13 +579,18 @@ M: integer detect-integer ;
     [ hashtable instance? ] \ instance? inlined?
 ] unit-test
 
-TUPLE: declared-fixnum { "x" fixnum } ;
+TUPLE: declared-fixnum { x fixnum } ;
 
 [ t ] [
     [ { declared-fixnum } declare [ 1 + ] change-x ]
     { + fixnum+ >fixnum } inlined?
 ] unit-test
 
+[ t ] [
+    [ { declared-fixnum } declare x>> drop ]
+    { slot } inlined?
+] unit-test
+
 ! Later
 
 ! [ t ] [

core/inspector/inspector.factor

@@ -79,11 +79,11 @@ SYMBOL: +editable+
 : summary. ( obj -- ) [ summary ] keep write-object nl ;
 
 : sorted-keys ( assoc -- alist )
-    dup mirror? [ keys ] [
+    dup hashtable? [
         keys
         [ [ unparse-short ] keep ] { } map>assoc
         sort-keys values
-    ] if ;
+    ] [ keys ] if ;
 
 : describe* ( obj flags -- )
     clone [

core/mirrors/mirrors-tests.factor

@@ -31,7 +31,7 @@ C: <foo> foo
 [ gensym <mirror> [ "compiled" off ] bind ] must-fail
 
 TUPLE: declared-mirror-test
-{ "a" integer initial: 0 } ;
+{ a integer initial: 0 } ;
 
 [ 5 ] [
     3 declared-mirror-test boa <mirror> [
@@ -43,9 +43,9 @@ TUPLE: declared-mirror-test
 [ 3 declared-mirror-test boa <mirror> [ t "a" set ] bind ] must-fail
 
 TUPLE: color
-{ "red" integer }
+{ red integer }
-{ "green" integer }
+{ green integer }
-{ "blue" integer } ;
+{ blue integer } ;
 
 [ T{ color f 0 0 0 } ] [
     1 2 3 color boa [ <mirror> clear-assoc ] keep

core/optimizer/inlining/inlining.factor

@@ -54,11 +54,15 @@ DEFER: (flat-length)
     [ def>> (flat-length) ] with-scope ;
 
 ! Single dispatch method inlining optimization
+! : dispatching-class ( node generic -- method/f )
+!     tuck dispatch# over in-d>> <reversed> ?nth 2dup node-literal?
+!     [ node-literal swap single-effective-method ]
+!     [ node-class swap specific-method ]
+!     if ;
+
 : dispatching-class ( node generic -- method/f )
-    tuck dispatch# over in-d>> <reversed> ?nth 2dup node-literal?
+    tuck dispatch# over in-d>> <reversed> ?nth
-    [ node-literal swap single-effective-method ]
+    node-class swap specific-method ;
-    [ node-class swap specific-method ]
-    if ;
 
 : inline-standard-method ( node generic -- node )
     dupd dispatching-class dup

core/prettyprint/prettyprint-tests.factor

@@ -101,11 +101,20 @@ unit-test
         ] keep =
     ] with-scope ;
 
-: method-test
+GENERIC: method-layout
+
+M: complex method-layout
+    "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+    ;
+
+M: fixnum method-layout ;
+
+M: integer method-layout ;
+
+M: object method-layout ;
+
+[
     {
-        "IN: prettyprint.tests"
-        "GENERIC: method-layout"
-        ""
         "USING: math prettyprint.tests ;"
         "M: complex method-layout"
         "    \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\""
@@ -119,10 +128,10 @@ unit-test
         ""
         "USING: kernel prettyprint.tests ;"
         "M: object method-layout ;"
-    } ;
+        ""
-
+    }
-[ t ] [
+] [
-    "method-layout" method-test check-see
+    [ \ method-layout see-methods ] with-string-writer "\n" split
 ] unit-test
 
 : retain-stack-test
@@ -255,7 +264,16 @@ DEFER: parse-error-file
     "another-narrow-layout" another-narrow-test check-see
 ] unit-test
 
-: class-see-test
+IN: prettyprint.tests
+TUPLE: class-see-layout ;
+
+IN: prettyprint.tests
+GENERIC: class-see-layout ( x -- y )
+
+USING: prettyprint.tests ;
+M: class-see-layout class-see-layout ;
+
+[
     {
         "IN: prettyprint.tests"
         "TUPLE: class-see-layout ;"
@@ -263,12 +281,19 @@ DEFER: parse-error-file
         "IN: prettyprint.tests"
         "GENERIC: class-see-layout ( x -- y )"
         ""
+    }
+] [
+    [ \ class-see-layout see ] with-string-writer "\n" split
+] unit-test
+
+[
+    {
         "USING: prettyprint.tests ;"
         "M: class-see-layout class-see-layout ;"
-    } ;
+        ""
-
+    }
-[ t ] [
+] [
-    "class-see-layout" class-see-test check-see
+    [ \ class-see-layout see-methods ] with-string-writer "\n" split
 ] unit-test
 
 [ ] [ \ effect-in synopsis drop ] unit-test

core/prettyprint/prettyprint.factor

@@ -268,13 +268,22 @@ M: predicate-class see-class*
 M: singleton-class see-class* ( class -- )
     \ SINGLETON: pprint-word pprint-word ;
 
+GENERIC: pprint-slot-name ( object -- )
+
+M: string pprint-slot-name text ;
+
+M: array pprint-slot-name
+    <flow \ { pprint-word
+    f <inset unclip text pprint-elements block>
+    \ } pprint-word block> ;
+
 M: tuple-class see-class*
     <colon \ TUPLE: pprint-word
     dup pprint-word
     dup superclass tuple eq? [
         "<" text dup superclass pprint-word
     ] unless
-    slot-names [ dup string? [ text ] [ pprint* ] if ] each
+    <block slot-names [ pprint-slot-name ] each block>
     pprint-; block> ;
 
 M: word see-class* drop ;
@@ -282,14 +291,6 @@ M: word see-class* drop ;
 M: builtin-class see-class*
     drop "! Built-in class" comment. ;
 
-: see-all ( seq -- )
-    natural-sort [ nl see ] each ;
-
-: see-implementors ( class -- seq )
-    dup implementors
-    [ method ] with map
-    natural-sort ;
-
 : see-class ( class -- )
     dup class? [
         [
@@ -297,9 +298,6 @@ M: builtin-class see-class*
         ] with-use nl
     ] when drop ;
 
-: see-methods ( generic -- seq )
-    "methods" word-prop values natural-sort ;
-
 M: word see
     dup see-class
     dup class? over symbol? not and [
@@ -308,8 +306,20 @@ M: word see
     dup class? over symbol? and not [
         [ dup (see) ] with-use nl
     ] when
+    drop ;
+
+: see-all ( seq -- )
+    natural-sort [ nl ] [ see ] interleave ;
+
+: (see-implementors) ( class -- seq )
+    dup implementors [ method ] with map natural-sort ;
+
+: (see-methods) ( generic -- seq )
+    "methods" word-prop values natural-sort ;
+
+: see-methods ( word -- )
     [
-        dup class? [ dup see-implementors % ] when
+        dup class? [ dup (see-implementors) % ] when
-        dup generic? [ dup see-methods % ] when
+        dup generic? [ dup (see-methods) % ] when
         drop
     ] { } make prune see-all ;

core/sbufs/sbufs.factor

@@ -5,8 +5,8 @@ strings growable strings.private ;
 IN: sbufs
 
 TUPLE: sbuf
-{ "underlying" string }
+{ underlying string }
-{ "length" array-capacity } ;
+{ length array-capacity } ;
 
 <PRIVATE
 

core/sequences/sequences.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2005, 2008 Slava Pestov, Daniel Ehrenberg.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel kernel.private slots.private math math.private
+USING: accessors kernel kernel.private slots.private math
-math.order ;
+math.private math.order ;
 IN: sequences
 
 MIXIN: sequence
@@ -161,25 +161,28 @@ M: virtual-sequence new-sequence virtual-seq new-sequence ;
 INSTANCE: virtual-sequence sequence
 
 ! A reversal of an underlying sequence.
-TUPLE: reversed seq ;
+TUPLE: reversed { seq read-only: t } ;
 
 C: <reversed> reversed
 
-M: reversed virtual-seq reversed-seq ;
+M: reversed virtual-seq seq>> ;
 
-M: reversed virtual@ reversed-seq [ length swap - 1- ] keep ;
+M: reversed virtual@ seq>> [ length swap - 1- ] keep ;
 
-M: reversed length reversed-seq length ;
+M: reversed length seq>> length ;
 
 INSTANCE: reversed virtual-sequence
 
 : reverse ( seq -- newseq ) [ <reversed> ] [ like ] bi ;
 
 ! A slice of another sequence.
-TUPLE: slice from to seq ;
+TUPLE: slice
+{ from read-only: t }
+{ to read-only: t }
+{ seq read-only: t } ;
 
 : collapse-slice ( m n slice -- m' n' seq )
-    dup slice-from swap slice-seq >r tuck + >r + r> r> ; inline
+    [ from>> ] [ seq>> ] bi >r tuck + >r + r> r> ; inline
 
 ERROR: slice-error reason ;
 
@@ -193,11 +196,11 @@ ERROR: slice-error reason ;
     check-slice
     slice boa ; inline
 
-M: slice virtual-seq slice-seq ;
+M: slice virtual-seq seq>> ;
 
-M: slice virtual@ [ slice-from + ] [ slice-seq ] bi ;
+M: slice virtual@ [ from>> + ] [ seq>> ] bi ;
 
-M: slice length dup slice-to swap slice-from - ;
+M: slice length [ to>> ] [ from>> ] bi - ;
 
 : short ( seq n -- seq n' ) over length min ; inline
 
@@ -216,12 +219,12 @@ M: slice length dup slice-to swap slice-from - ;
 INSTANCE: slice virtual-sequence
 
 ! One element repeated many times
-TUPLE: repetition len elt ;
+TUPLE: repetition { len read-only: t } { elt read-only: t } ;
 
 C: <repetition> repetition
 
-M: repetition length repetition-len ;
+M: repetition length len>> ;
-M: repetition nth-unsafe nip repetition-elt ;
+M: repetition nth-unsafe nip elt>> ;
 
 INSTANCE: repetition immutable-sequence
 

core/slots/deprecated/deprecated.factor

@@ -16,12 +16,17 @@ PREDICATE: slot-reader < word "reading" word-prop >boolean ;
     swap "declared-effect" set-word-prop
     slot-spec-reader swap "reading" set-word-prop ;
 
+: define-slot-word ( class word quot -- )
+    [
+        dup define-simple-generic
+        create-method
+    ] dip define ;
+
 : define-reader ( class spec -- )
     dup slot-spec-reader [
         [ set-reader-props ] 2keep
-        dup slot-spec-offset
+        dup slot-spec-reader
-        over slot-spec-reader
+        swap reader-quot
-        rot slot-spec-class reader-quot
         define-slot-word
     ] [
         2drop
@@ -41,9 +46,8 @@ PREDICATE: slot-writer < word "writing" word-prop >boolean ;
 : define-writer ( class spec -- )
     dup slot-spec-writer [
         [ set-writer-props ] 2keep
-        dup slot-spec-offset
+        dup slot-spec-writer
-        swap slot-spec-writer
+        swap writer-quot
-        [ set-slot ]
         define-slot-word
     ] [
         2drop

core/slots/slots-docs.factor

@@ -113,11 +113,6 @@ HELP: define-typecheck
 }
 { $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 } }
-{ $description "Defines " { $snippet "word" } " to be a simple type-checking generic word that receives the slot number on the stack as a fixnum." }
-$low-level-note ;
-
 HELP: define-reader
 { $values { "class" class } { "name" string } { "slot" integer } }
 { $description "Defines a reader word to read a slot from instances of " { $snippet "class" } "." }

core/slots/slots-tests.factor

@@ -1,13 +1,14 @@
 IN: slots.tests
-USING: math accessors slots strings generic.standard kernel tools.test ;
+USING: math accessors slots strings generic.standard kernel
+tools.test generic words parser ;
 
 TUPLE: r/w-test foo ;
 
-TUPLE: r/o-test { "foo" read-only: t } ;
+TUPLE: r/o-test { foo read-only: t } ;
 
 [ r/o-test new 123 >>foo ] [ no-method? ] must-fail-with
 
-TUPLE: decl-test { "foo" integer } ;
+TUPLE: decl-test { foo integer } ;
 
 [ decl-test new 1.0 >>foo ] [ bad-slot-value? ] must-fail-with
 
@@ -16,3 +17,20 @@ TUPLE: hello length ;
 [ 3 ] [ "xyz" length>> ] unit-test
 
 [ "xyz" 4 >>length ] [ no-method? ] must-fail-with
+
+[ t ] [ r/o-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/o-test \ foo>> method "flushable" word-prop ] unit-test
+
+[ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
+
+! See if declarations are cleared on redefinition
+[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only: t } ;" eval ] unit-test
+
+[ t ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test
+
+[ ] [ "IN: slots.tests TUPLE: r/w-test { foo read-only: f } ;" eval ] unit-test
+
+[ f ] [ r/w-test \ foo>> method "foldable" word-prop ] unit-test
+[ t ] [ r/w-test \ foo>> method "flushable" word-prop ] unit-test

core/slots/slots.factor

@@ -3,7 +3,7 @@
 USING: arrays bit-arrays byte-arrays float-arrays kernel
 kernel.private math namespaces sequences strings words effects
 generic generic.standard classes classes.algebra slots.private
-combinators accessors words ;
+combinators accessors words sequences.private assocs ;
 IN: slots
 
 TUPLE: slot-spec name offset class initial read-only reader writer ;
@@ -12,69 +12,71 @@ TUPLE: slot-spec name offset class initial read-only reader writer ;
     slot-spec new
         object bootstrap-word >>class ;
 
-: define-typecheck ( class generic quot -- )
+: define-typecheck ( class generic quot props -- )
-    [
+    [ dup define-simple-generic create-method ] 2dip
-        dup define-simple-generic
+    [ [ props>> ] [ drop ] [ [ t ] H{ } map>assoc ] tri* update ]
-        create-method
+    [ drop define ]
-    ] dip define ;
+    3bi ;
-
-: 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 )
+: reader-quot ( slot-spec -- quot )
     [
+        dup offset>> ,
         \ slot ,
-        dup object bootstrap-word eq?
+        dup class>> object bootstrap-word eq?
-        [ drop ] [ 1array , \ declare , ] if
+        [ drop ] [ class>> 1array , \ declare , ] if
     ] [ ] make ;
 
 : reader-word ( name -- word )
     ">>" append (( object -- value )) create-accessor ;
 
+: reader-props ( slot-spec -- seq )
+    read-only>> { "foldable" "flushable" } { "flushable" } ? ;
+
 : define-reader ( class slot-spec -- )
-    [ offset>> ]
+    [ name>> reader-word ] [ reader-quot ] [ reader-props ] tri
-    [ name>> reader-word ]
+    define-typecheck ;
-    [ class>> reader-quot ]
-    tri define-slot-word ;
 
 : writer-word ( name -- word )
     "(>>" swap ")" 3append (( value object -- )) create-accessor ;
 
 ERROR: bad-slot-value value object index ;
 
-: writer-quot/object ( decl -- )
+: writer-quot/object ( slot-spec -- )
-    drop \ set-slot , ;
+    offset>> , \ set-slot , ;
 
-: writer-quot/coerce ( decl -- )
+: writer-quot/coerce ( slot-spec -- )
-    [ rot ] % "coercer" word-prop % [ -rot set-slot ] % ;
+    [ \ >r , class>> "coercer" word-prop % \ r> , ]
+    [ offset>> , \ set-slot , ]
+    bi ;
 
-: writer-quot/check ( decl -- )
+: writer-quot/check ( slot-spec -- )
-    \ pick ,
+    [ offset>> , ]
-    "predicate" word-prop %
+    [
-    [ [ set-slot ] [ bad-slot-value ] if ] % ;
+        \ pick ,
+        class>> "predicate" word-prop %
+        [ [ set-slot ] [ bad-slot-value ] if ] %
+    ]
+    bi ;
 
-: writer-quot/fixnum ( decl -- )
+: writer-quot/fixnum ( slot-spec -- )
-    [ rot >fixnum -rot ] % writer-quot/check ;
+    [ >r >fixnum r> ] % writer-quot/check ;
 
-: writer-quot ( decl -- quot )
+: writer-quot ( slot-spec -- quot )
     [
         {
-            { [ dup object bootstrap-word eq? ] [ writer-quot/object ] }
+            { [ dup class>> object bootstrap-word eq? ] [ writer-quot/object ] }
-            { [ dup "coercer" word-prop ] [ writer-quot/coerce ] }
+            { [ dup class>> "coercer" word-prop ] [ writer-quot/coerce ] }
-            { [ dup fixnum class<= ] [ writer-quot/fixnum ] }
+            { [ dup class>> fixnum bootstrap-word class<= ] [ writer-quot/fixnum ] }
             [ writer-quot/check ]
         } cond
     ] [ ] make ;
 
 : define-writer ( class slot-spec -- )
-    [ offset>> ]
+    [ name>> writer-word ] [ writer-quot ] bi { } define-typecheck ;
-    [ name>> writer-word ]
-    [ class>> writer-quot ]
-    tri define-slot-word ;
 
 : setter-word ( name -- word )
     ">>" prepend (( object value -- object )) create-accessor ;
@@ -123,13 +125,14 @@ ERROR: no-initial-value class ;
 
 : initial-value ( class -- object )
     {
-        { [ \ f over class<= ] [ f ] }
+        { [ \ f bootstrap-word over class<= ] [ f ] }
-        { [ fixnum over class<= ] [ 0 ] }
+        { [ \ array-capacity bootstrap-word over class<= ] [ 0 ] }
-        { [ float over class<= ] [ 0.0 ] }
+        { [ float bootstrap-word over class<= ] [ 0.0 ] }
-        { [ array over class<= ] [ { } ] }
+        { [ string bootstrap-word over class<= ] [ "" ] }
-        { [ bit-array over class<= ] [ ?{ } ] }
+        { [ array bootstrap-word over class<= ] [ { } ] }
-        { [ byte-array over class<= ] [ B{ } ] }
+        { [ bit-array bootstrap-word over class<= ] [ ?{ } ] }
-        { [ float-array over class<= ] [ F{ } ] }
+        { [ byte-array bootstrap-word over class<= ] [ B{ } ] }
+        { [ float-array bootstrap-word over class<= ] [ F{ } ] }
         [ no-initial-value ]
     } cond nip ;
 
@@ -164,8 +167,10 @@ ERROR: bad-initial-value name ;
 
 : check-initial-value ( slot-spec -- slot-spec )
     dup initial>> [
-        dup [ initial>> ] [ class>> ] bi instance?
+        [ ] [
-        [ name>> bad-initial-value ] unless
+            dup [ initial>> ] [ class>> ] bi instance?
+            [ name>> bad-initial-value ] unless
+        ] if-bootstrapping
     ] [
         dup class>> initial-value >>initial
     ] if ;

core/vectors/vectors.factor

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

extra/bit-vectors/bit-vectors.factor

@@ -6,8 +6,8 @@ parser accessors ;
 IN: bit-vectors
 
 TUPLE: bit-vector
-{ "underlying" bit-array }
+{ underlying bit-array }
-{ "length" array-capacity } ;
+{ length array-capacity } ;
 
 <PRIVATE
 

extra/float-vectors/float-vectors.factor

@@ -6,8 +6,8 @@ parser accessors ;
 IN: float-vectors
 
 TUPLE: float-vector
-{ "underlying" float-array }
+{ underlying float-array }
-{ "length" array-capacity } ;
+{ length array-capacity } ;
 
 <PRIVATE
 

extra/io/buffers/buffers.factor

@@ -7,10 +7,10 @@ hints accessors math.order destructors combinators ;
 IN: io.buffers
 
 TUPLE: buffer
-{ "size" fixnum }
+{ size fixnum }
-{ "ptr" simple-alien }
+{ ptr simple-alien initial: ALIEN: -1 }
-{ "fill" fixnum }
+{ fill fixnum }
-{ "pos" fixnum }
+{ pos fixnum }
 disposed ;
 
 : <buffer> ( n -- buffer )

extra/math/ranges/ranges.factor

@@ -2,7 +2,10 @@ USING: kernel layouts math math.order namespaces sequences
 sequences.private accessors ;
 IN: math.ranges
 
-TUPLE: range from length step ;
+TUPLE: range
+{ from read-only: t }
+{ length read-only: t }
+{ step read-only: t } ;
 
 : <range> ( a b step -- range )
     >r over - r>
@@ -23,19 +26,19 @@ INSTANCE: range immutable-sequence
 
 : ,b) dup neg rot + swap ; inline
 
-: [a,b] ( a b -- range ) twiddle <range> ;
+: [a,b] ( a b -- range ) twiddle <range> ; foldable
 
-: (a,b] ( a b -- range ) twiddle (a, <range> ;
+: (a,b] ( a b -- range ) twiddle (a, <range> ; foldable
 
-: [a,b) ( a b -- range ) twiddle ,b) <range> ;
+: [a,b) ( a b -- range ) twiddle ,b) <range> ; foldable
 
-: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ;
+: (a,b) ( a b -- range ) twiddle (a, ,b) <range> ; foldable
 
-: [0,b] ( b -- range ) 0 swap [a,b] ;
+: [0,b] ( b -- range ) 0 swap [a,b] ; foldable
 
-: [1,b] ( b -- range ) 1 swap [a,b] ;
+: [1,b] ( b -- range ) 1 swap [a,b] ; foldable
 
-: [0,b) ( b -- range ) 0 swap [a,b) ;
+: [0,b) ( b -- range ) 0 swap [a,b) ; foldable
 
 : range-increasing? ( range -- ? )
     step>> 0 > ;