"T{ rectangle { width 3 } { height 5 } }"
} ;
+HELP: copy-slots{
+{ $description "Copy slots from the first object to the second and return the second object." }
+{ $example "USING: prettyprint slots.syntax kernel ;"
+ "IN: slots.syntax.example"
+ "TUPLE: thing1 a b ;"
+ "TUPLE: thing2 a b c ;"
+ "1 2 thing1 boa 11 22 33 thing2 boa copy-slots{ a b } ."
+ "T{ thing2 f 1 2 33 }"
+} ;
+
ARTICLE: "slots.syntax" "Slots syntax sugar"
"The " { $vocab-link "slots.syntax" } " vocabulary provides an alternative syntax for getting and setting multiple values of a tuple." $nl
"Syntax sugar for cleaving slots to the stack:"
-{ $subsections POSTPONE: slots[ }
+{ $subsections POSTPONE: slots[ POSTPONE: get[ }
"Cleaving slots to an array:"
-{ $subsections POSTPONE: slots{ }
+{ $subsections POSTPONE: slots{ POSTPONE: get{ }
"Setting slots from the stack:"
-{ $subsections POSTPONE: set-slots[ }
+{ $subsections POSTPONE: set-slots[ POSTPONE: set[ }
"Setting slots from an array:"
-{ $subsections POSTPONE: set-slots{ } ;
+{ $subsections POSTPONE: set-slots{ POSTPONE: set{ } ;
ABOUT: "slots.syntax"
! Copyright (C) 2010 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: tools.test slots.syntax ;
+USING: kernel tools.test slots.syntax ;
IN: slots.syntax.tests
-TUPLE: slot-test a b c ;
+TUPLE: slot-test1 a b c ;
-[ 1 2 3 ] [ T{ slot-test f 1 2 3 } slots[ a b c ] ] unit-test
-[ 3 ] [ T{ slot-test f 1 2 3 } slots[ c ] ] unit-test
-[ ] [ T{ slot-test f 1 2 3 } slots[ ] ] unit-test
+[ 1 2 3 ] [ T{ slot-test1 f 1 2 3 } slots[ a b c ] ] unit-test
+[ 3 ] [ T{ slot-test1 f 1 2 3 } slots[ c ] ] unit-test
+[ ] [ T{ slot-test1 f 1 2 3 } slots[ ] ] unit-test
-[ { 1 2 3 } ] [ T{ slot-test f 1 2 3 } slots{ a b c } ] unit-test
-[ { 3 } ] [ T{ slot-test f 1 2 3 } slots{ c } ] unit-test
-[ { } ] [ T{ slot-test f 1 2 3 } slots{ } ] unit-test
+[ { 1 2 3 } ] [ T{ slot-test1 f 1 2 3 } slots{ a b c } ] unit-test
+[ { 3 } ] [ T{ slot-test1 f 1 2 3 } slots{ c } ] unit-test
+[ { } ] [ T{ slot-test1 f 1 2 3 } slots{ } ] unit-test
+
+TUPLE: slot-test2 a b c d ;
+
+[ T{ slot-test2 f 1 2 33 44 } ]
+[ 1 2 3 slot-test1 boa 11 22 33 44 slot-test2 boa copy-slots{ a b } ] unit-test
"}" [ reader-word 1quotation ] map-tokens
'[ [ _ cleave ] output>array ] append! ;
-: writer-word* ( name -- word )
+: >>writer-word ( name -- word )
+ ">>" prepend "accessors" lookup ;
+
+: writer-word<< ( name -- word )
">>" prepend "accessors" lookup ;
SYNTAX: set-slots[
- "]" [ writer-word* 1quotation ] map-tokens
+ "]" [ >>writer-word 1quotation ] map-tokens
'[ _ spread ] append! ;
SYNTAX: set-slots{
- "}" [ writer-word* 1quotation ] map-tokens
+ "}" [ >>writer-word 1quotation ] map-tokens
[ length ] [ ] bi
'[ _ firstn _ spread ] append! ;
+
+SYNTAX: copy-slots{
+ "}" [
+ [ reader-word 1quotation ]
+ [ writer-word<< 1quotation ] bi append
+ ] map-tokens
+ '[ swap _ cleave ] append! ;
+
+SYNTAX: get[ POSTPONE: slots[ ;
+SYNTAX: get{ POSTPONE: slots{ ;
+SYNTAX: set[ POSTPONE: set-slots[ ;
+SYNTAX: set{ POSTPONE: set-slots{ ;